import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) : ∀ ε > 0, ∃ n : ℤ, |α * n - (α * n)%ℤ| < ε :=
begin
  assume ε hε,
  have h1 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α = (j : ℝ) * α,
    have h3 : α = (j - i)⁻¹ * (⌊(i : ℝ) * α⌋ - ⌊(j : ℝ) * α⌋), from by {
      rw [← h2, mul_sub, mul_sub, mul_assoc, mul_comm α (j - i), mul_inv_cancel h],
      ring,
    },
    exact hα h3,
  },
  have h2 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α % 1 = (j : ℝ) * α % 1,
    have h3 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw [← h2, sub_eq_zero],
      ring,
    },
    exact h1 i j h h3,
  },
  have h3 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α % 1 = (j : ℝ) * α % 1,
    have h3 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw [← h2, sub_eq_zero],
      ring,
    },
    exact h1 i j h h3,
  },
  have h4 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α % 1 = (j : ℝ) * α % 1,
    have h3 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw [← h2, sub_eq_zero],
      ring,
    },
    exact h1 i j h h3,
  },
  have h5 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α % 1 = (j : ℝ) * α % 1,
    have h3 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw [← h2, sub_eq_zero],
      ring,
    },
    exact h1 i j h h3,
  },
  have h6 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α % 1 = (j : ℝ) * α % 1,
    have h3 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw [← h2, sub_eq_zero],
      ring,
    },
    exact h1 i j h h3,
  },
  have h7 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α % 1 = (j : ℝ) * α % 1,
    have h3 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw [← h2, sub_eq_zero],
      ring,
    },
    exact h1 i j h h3,
  },
  have h8 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α % 1 = (j : ℝ) * α % 1,
    have h3 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw [← h2, sub_eq_zero],
      ring,
    },
    exact h1 i j h h3,
  },
  have h9 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α % 1 = (j : ℝ) * α % 1,
    have h3 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw [← h2, sub_eq_zero],
      ring,
    },
    exact h1 i j h h3,
  },
  have h10 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α % 1 = (j : ℝ) * α % 1,
    have h3 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw [← h2, sub_eq_zero],
      ring,
    },
    exact h1 i j h h3,
  },
  have h11 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α % 1 = (j : ℝ) * α % 1,
    have h3 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw [← h2, sub_eq_zero],
      ring,
    },
    exact h1 i j h h3,
  },
  have h12 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α % 1 = (j : ℝ) * α % 1,
    have h3 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw [← h2, sub_eq_zero],
      ring,
    },
    exact h1 i j h h3,
  },
  have h13 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by {
    assume i j h,
    assume h2 : (i : ℝ) * α % 1 = (j : ℝ
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ (α ∈ ℚ)) : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, |y - x| < 1 :=
begin
  assume y h,
  have h1 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {
    assume i : ℤ,
    use (i + 1),
    split,
    assume h2 : i = i + 1,
    have h3 : i * α = (i + 1) * α, from by {rw h2, ring},
    have h4 : i * α ∈ ℚ, from by {apply exists_rat_btwn hα h3},
    have h5 : i * α ∈ ℤ, from by {apply exists_int_btwn h4},
    have h6 : i ∈ ℤ, from by {apply exists_int_btwn h5},
    have h7 : i + 1 ∈ ℤ, from by {apply exists_int_btwn h6},
    have h8 : i + 1 = i, from by {rw ← h7, ring},
    exact absurd h8 dec_trivial,
    obviously,
  },
  cases h1 0 with j h2,
  have h3 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {
    assume i : ℤ,
    cases h1 i with j h4,
    use j,
    split,
    exact h4.left,
    have h5 : (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {rw h4.right},
    exact h5,
  },
  have h4 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {
    assume i : ℤ,
    cases h3 i with j h5,
    use j,
    split,
    exact h5.left,
    have h6 : (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {rw h5.right},
    exact h6,
  },
  have h5 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {
    assume i : ℤ,
    cases h4 i with j h6,
    use j,
    split,
    exact h6.left,
    have h7 : (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {rw h6.right},
    exact h7,
  },
  have h6 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {
    assume i : ℤ,
    cases h5 i with j h7,
    use j,
    split,
    exact h7.left,
    have h8 : (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {rw h7.right},
    exact h8,
  },
  have h7 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {
    assume i : ℤ,
    cases h6 i with j h8,
    use j,
    split,
    exact h8.left,
    have h9 : (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {rw h8.right},
    exact h9,
  },
  have h8 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {
    assume i : ℤ,
    cases h7 i with j h9,
    use j,
    split,
    exact h9.left,
    have h10 : (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {rw h9.right},
    exact h10,
  },
  have h9 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {
    assume i : ℤ,
    cases h8 i with j h10,
    use j,
    split,
    exact h10.left,
    have h11 : (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {rw h10.right},
    exact h11,
  },
  have h10 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {
    assume i : ℤ,
    cases h9 i with j h11,
    use j,
    split,
    exact h11.left,
    have h12 : (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {rw h11.right},
    exact h12,
  },
  have h11 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {
    assume i : ℤ,
    cases h10 i with j h12,
    use j,
    split,
    exact h12.left,
    have h13 : (set.Icc 0 1).Icc (i * α) (i * α + 1) = (set.Icc 0 1).Icc (j * α) (j * α + 1), from by {rw h12.right},
    exact h
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ≠ y ∧ x - y < 1 :=
begin
  assume (y : ℝ) (h1 : y ∈ Icc 0 1),
  have h2 : ∀ n : ℕ, ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
    assume n : ℕ,
    have h3 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
      have h4 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
        have h5 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
          have h6 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
            have h7 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
              have h8 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                have h9 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                  have h10 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                    have h11 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                      have h12 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                        have h13 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                          have h14 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                            have h15 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                              have h16 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                have h17 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                  have h18 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                    have h19 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                      have h20 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                        have h21 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                          have h22 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                            have h23 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                              have h24 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                have h25 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                  have h26 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                    have h27 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                      have h28 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                        have h29 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                          have h30 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                            have h31 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                              have h32 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                have h33 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                  have h34 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                    have h35 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                      have h36 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                        have h37 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                          have h38 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                            have h39 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                              have h40 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                                have h41 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                                have h42 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                                have h43 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                                have h44 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                                have h45 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                                have h46 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                                have h47 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                                have h48 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ x ≠ y ∧ x - y < 1, from by {
                                                                                have h49 : ∃ x : ℝ,
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`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by
  {
    intro x0,
    have h6 : |x0 - l| < ε ↔ ((x0 - l) < ε) ∧ ((l - x0) < ε),
    from abs_sub_lt_iff, rw h6,
    split,
    rintro ⟨ S_1, S_2 ⟩,
    split; linarith,
    rintro ⟨ S_3, S_4 ⟩,
    split; linarith,
    },

  assume (h7 : ε > 0),
  cases h2 ε h7 with N1 h8,
  cases h3 ε h7 with N2 h9,

  let N := max N1 N2,
  use N,

  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by {
    assume n h,
    split,
    exact lt_of_le_of_lt (le_max_left N1 N2) h,
    exact lt_of_le_of_lt (le_max_right N1 N2) h,
  },

  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by {
    intros n h12,
    split,
    {

      have h13 := (h8 n (h10 n h12).left), rw h5 (y n) at h13,
      split,
      exact h13.left,
      exact (h4 n).left,
    },
    {
      have h14 := (h9 n (h10 n h12).right),rw h5 (z n) at h14,
      split,
      exact (h4 n).right,
      exact h14.right,
    },

  },

  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by {
    intros n1 h16, cases (h11 n1 h16);
    split; linarith,
  },

  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by {
    intros n h17,
    cases h5 (x n) with h18 h19,
    apply h19, exact h15 n h17,
  },
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


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

! This file was ported from Lean 3 source module category_theory.limits.kan_extension
! leanprover-community/mathlib commit c9c9fa15fec7ca18e9ec97306fb8764bfe988a7e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Shapes.Terminal
import Mathlib.CategoryTheory.PUnit
import Mathlib.CategoryTheory.StructuredArrow

/-!

# Kan extensions

This file defines the right and left Kan extensions of a functor.
They exist under the assumption that the target category has enough limits
resp. colimits.

The main definitions are `Ran ι` and `Lan ι`, where `ι : S ⥤ L` is a functor.
Namely, `Ran ι` is the right Kan extension, while `Lan ι` is the left Kan extension,
both as functors `(S ⥤ D) ⥤ (L ⥤ D)`.

To access the right resp. left adjunction associated to these, use `Ran.adjunction`
resp. `Lan.adjunction`.

# Projects

A lot of boilerplate could be generalized by defining and working with pseudofunctors.

-/

noncomputable section

namespace CategoryTheory

open Limits

universe v v₁ v₂ v₃ u₁ u₂ u₃

variable {S : Type u₁} {L : Type u₂} {D : Type u₃}

variable [Category.{v₁} S] [Category.{v₂} L] [Category.{v₃} D]

variable (ι : S ⥤ L)

namespace Ran

attribute [local simp] StructuredArrow.proj

/-- The diagram indexed by `Ran.index ι x` used to define `Ran`. -/
abbrev diagram (F : S ⥤ D) (x : L) : StructuredArrow x ι ⥤ D :=
  StructuredArrow.proj x ι ⋙ F
set_option linter.uppercaseLean3 false in
  #align category_theory.Ran.diagram CategoryTheory.Ran.diagram

variable {ι}

/-- A cone over `Ran.diagram ι F x` used to define `Ran`. -/
@[simp]
def cone {F : S ⥤ D} {G : L ⥤ D} (x : L) (f : ι ⋙ G ⟶ F) : Cone (diagram ι F x)
    where
  pt := G.obj x
  π :=
    { app := fun i => G.map i.hom ≫ f.app i.right
      naturality := by
        rintro ⟨⟨il⟩, ir, i⟩ ⟨⟨jl⟩, jr, j⟩ ⟨⟨⟨fl⟩⟩, fr, ff⟩
        dsimp at *
        dsimp at ff
        simp only [Category.id_comp, Category.assoc] at *
        rw [ff]
        have := f.naturality
        aesop_cat }
set_option linter.uppercaseLean3 false in
  #align category_theory.Ran.cone CategoryTheory.Ran.cone

variable (ι)

/-- An auxiliary definition used to define `Ran`. -/
@[simps]
def loc (F : S ⥤ D) [h : ∀ x, HasLimit (diagram ι F x)] : L ⥤ D
    where
  obj x := limit (diagram ι F x)
  map {X Y} f :=
    haveI : HasLimit <| StructuredArrow.map f ⋙ diagram ι F X := h Y
    limit.pre (diagram ι F X) (StructuredArrow.map f)
  map_id := by
    intro l
    haveI : HasLimit (StructuredArrow.map (𝟙 _) ⋙ diagram ι F l) := h _
    dsimp
    ext j
    simp only [Category.id_comp, limit.pre_π]
    congr 1
    simp
  map_comp := by
    intro x y z f g
    apply limit.hom_ext
    intro j
    -- Porting note: The fact that we need to add these instances all over the place
    -- is certainly not ideal.
    haveI : HasLimit (StructuredArrow.map f ⋙ diagram ι F _) := h _
    haveI : HasLimit (StructuredArrow.map g ⋙ diagram ι F _) := h _
    haveI : HasLimit (StructuredArrow.map (f ≫ g) ⋙ diagram ι F _) := h _
    haveI : HasLimit (StructuredArrow.map g ⋙ StructuredArrow.map f ⋙ diagram ι F _) := h _
    haveI : HasLimit ((StructuredArrow.map g ⋙ StructuredArrow.map f) ⋙ diagram ι F _) := h _
    erw [limit.pre_pre, limit.pre_π, limit.pre_π]
    congr 1
    aesop_cat
set_option linter.uppercaseLean3 false in
  #align category_theory.Ran.loc CategoryTheory.Ran.loc

/-- An auxiliary definition used to define `Ran` and `Ran.adjunction`. -/
@[simps]
def equiv (F : S ⥤ D) [h : ∀ x, HasLimit (diagram ι F x)] (G : L ⥤ D) :
    (G ⟶ loc ι F) ≃ (((whiskeringLeft _ _ _).obj ι).obj G ⟶ F)
    where
  toFun f :=
    { app := fun x => f.app _ ≫ limit.π (diagram ι F (ι.obj x)) (StructuredArrow.mk (𝟙 _))
      naturality := by
        intro x y ff
        dsimp only [whiskeringLeft]
        simp only [Functor.comp_map, NatTrans.naturality_assoc, loc_map, Category.assoc]
        congr 1
        haveI : HasLimit (StructuredArrow.map (ι.map ff) ⋙ diagram ι F (ι.obj x)) := h _
        erw [limit.pre_π]
        let t : StructuredArrow.mk (𝟙 (ι.obj x)) ⟶
          (StructuredArrow.map (ι.map ff)).obj (StructuredArrow.mk (𝟙 (ι.obj y))) :=
          StructuredArrow.homMk ff ?_
        convert (limit.w (diagram ι F (ι.obj x)) t).symm using 1
        simp }
  invFun f :=
    { app := fun x => limit.lift (diagram ι F x) (cone _ f)
      naturality := by
        intro x y ff
        apply limit.hom_ext
        intros j
        haveI : HasLimit (StructuredArrow.map ff ⋙ diagram ι F x) := h _
        erw [limit.lift_pre, limit.lift_π, Category.assoc, limit.lift_π (cone _ f) j]
        simp }
  left_inv := by
    intro x
    ext k
    apply limit.hom_ext
    intros j
    dsimp only [cone]
    rw [limit.lift_π]
    simp only [NatTrans.naturality_assoc, loc_map]
    haveI : HasLimit (StructuredArrow.map j.hom ⋙ diagram ι F k) := h _
    erw [limit.pre_π]
    congr
    rcases j with ⟨⟨⟩, _, _⟩
    aesop_cat
  right_inv := by aesop_cat
set_option linter.uppercaseLean3 false in
  #align category_theory.Ran.equiv CategoryTheory.Ran.equiv

end Ran

/-- The right Kan extension of a functor. -/
@[simps!]
def ran [∀ X, HasLimitsOfShape (StructuredArrow X ι) D] : (S ⥤ D) ⥤ L ⥤ D :=
  Adjunction.rightAdjointOfEquiv (fun F G => (Ran.equiv ι G F).symm) (by {
    -- Porting note: was `tidy`
    intros X' X Y f g
    ext t
    apply limit.hom_ext
    intros j
    dsimp [Ran.equiv]
    simp })
set_option linter.uppercaseLean3 false in
  #align category_theory.Ran CategoryTheory.ran

namespace Ran

variable (D)

/-- The adjunction associated to `Ran`. -/
def adjunction [∀ X, HasLimitsOfShape (StructuredArrow X ι) D] :
    (whiskeringLeft _ _ D).obj ι ⊣ ran ι :=
  Adjunction.adjunctionOfEquivRight _ _
set_option linter.uppercaseLean3 false in
  #align category_theory.Ran.adjunction CategoryTheory.Ran.adjunction

theorem reflective [Full ι] [Faithful ι] [∀ X, HasLimitsOfShape (StructuredArrow X ι) D] :
    IsIso (adjunction D ι).counit := by
  suffices : ∀ (X : S ⥤ D), IsIso (NatTrans.app (adjunction D ι).counit X)
  · apply NatIso.isIso_of_isIso_app
  intro F
  suffices : ∀ (X : S), IsIso (NatTrans.app (NatTrans.app (adjunction D ι).counit F) X)
  · apply NatIso.isIso_of_isIso_app
  intro X
  dsimp [adjunction, equiv]
  simp only [Category.id_comp]
  exact
    IsIso.of_iso
      ((limit.isLimit _).conePointUniqueUpToIso
        (limitOfDiagramInitial StructuredArrow.mkIdInitial _))
set_option linter.uppercaseLean3 false in
  #align category_theory.Ran.reflective CategoryTheory.Ran.reflective

end Ran

namespace Lan

attribute [local simp] CostructuredArrow.proj

/-- The diagram indexed by `Lan.index ι x` used to define `Lan`. -/
abbrev diagram (F : S ⥤ D) (x : L) : CostructuredArrow ι x ⥤ D :=
  CostructuredArrow.proj ι x ⋙ F
set_option linter.uppercaseLean3 false in
  #align category_theory.Lan.diagram CategoryTheory.Lan.diagram

variable {ι}

/-- A cocone over `Lan.diagram ι F x` used to define `Lan`. -/
@[simp]
def cocone {F : S ⥤ D} {G : L ⥤ D} (x : L) (f : F ⟶ ι ⋙ G) : Cocone (diagram ι F x)
    where
  pt := G.obj x
  ι :=
    { app := fun i => f.app i.left ≫ G.map i.hom
      naturality := by
        rintro ⟨ir, ⟨il⟩, i⟩ ⟨jl, ⟨jr⟩, j⟩ ⟨fl, ⟨⟨fl⟩⟩, ff⟩
        dsimp at *
        simp only [Functor.comp_map, Category.comp_id, NatTrans.naturality_assoc]
        rw [← G.map_comp, ff]
        aesop_cat }
set_option linter.uppercaseLean3 false in
  #align category_theory.Lan.cocone CategoryTheory.Lan.cocone

variable (ι)

/-- An auxiliary definition used to define `Lan`. -/
@[simps]
def loc (F : S ⥤ D) [I : ∀ x, HasColimit (diagram ι F x)] : L ⥤ D
    where
  obj x := colimit (diagram ι F x)
  map {x y} f :=
    haveI : HasColimit (CostructuredArrow.map f ⋙ diagram ι F y) := I _
    colimit.pre (diagram ι F y) (CostructuredArrow.map f)
  map_id := by
    intro l
    dsimp
    haveI : HasColimit (CostructuredArrow.map (𝟙 l) ⋙ diagram ι F l) := I _
    ext j
    erw [colimit.ι_pre, Category.comp_id]
    congr 1
    simp
  map_comp := by
    intro x y z f g
    dsimp
    haveI : HasColimit (CostructuredArrow.map (f ≫ g) ⋙ diagram ι F z) := I _
    ext j
    let ff : CostructuredArrow ι _ ⥤ _ := CostructuredArrow.map f
    let gg : CostructuredArrow ι _ ⥤ _ := CostructuredArrow.map g
    let dd := diagram ι F z
    -- Porting note: It seems that even Lean3 had some trouble with instances in this case.
    -- I don't know why lean can't deduce the following three instances...
    haveI : HasColimit (ff ⋙ gg ⋙ dd) := I _
    haveI : HasColimit ((ff ⋙ gg) ⋙ dd) := I _
    haveI : HasColimit (gg ⋙ dd) := I _
    change _ = colimit.ι ((ff ⋙ gg) ⋙ dd) j ≫ _ ≫ _
    erw [colimit.pre_pre dd gg ff, colimit.ι_pre, colimit.ι_pre]
    congr 1
    simp
set_option linter.uppercaseLean3 false in
  #align category_theory.Lan.loc CategoryTheory.Lan.loc

/-- An auxiliary definition used to define `Lan` and `Lan.adjunction`. -/
@[simps]
def equiv (F : S ⥤ D) [I : ∀ x, HasColimit (diagram ι F x)] (G : L ⥤ D) :
    (loc ι F ⟶ G) ≃ (F ⟶ ((whiskeringLeft _ _ _).obj ι).obj G)
    where
  toFun f :=
    { app := fun x => colimit.ι (diagram ι F (ι.obj x)) (CostructuredArrow.mk (𝟙 _)) ≫ f.app _
      naturality := by
        intro x y ff
        dsimp only [whiskeringLeft]
        simp only [Functor.comp_map, Category.assoc]
        rw [← f.naturality (ι.map ff), ← Category.assoc, ← Category.assoc]
        let fff : CostructuredArrow ι _ ⥤ _ := CostructuredArrow.map (ι.map ff)
        -- same issue :-(
        haveI : HasColimit (fff ⋙ diagram ι F (ι.obj y)) := I _
        erw [colimit.ι_pre (diagram ι F (ι.obj y)) fff (CostructuredArrow.mk (𝟙 _))]
        let xx : CostructuredArrow ι (ι.obj y) := CostructuredArrow.mk (ι.map ff)
        let yy : CostructuredArrow ι (ι.obj y) := CostructuredArrow.mk (𝟙 _)
        let fff : xx ⟶ yy :=
          CostructuredArrow.homMk ff
            (by
              simp only [CostructuredArrow.mk_hom_eq_self]
              erw [Category.comp_id])
        erw [colimit.w (diagram ι F (ι.obj y)) fff]
        congr
        simp }
  invFun f :=
    { app := fun x => colimit.desc (diagram ι F x) (cocone _ f)
      naturality := by
        intro x y ff
        apply colimit.hom_ext
        intros j
        haveI : HasColimit (CostructuredArrow.map ff ⋙ diagram ι F y) := I _
        erw [colimit.pre_desc, ← Category.assoc, colimit.ι_desc, colimit.ι_desc]
        simp }
  left_inv := by
    intros x
    dsimp
    ext k
    dsimp
    apply colimit.hom_ext
    intros j
    rw [colimit.ι_desc]
    dsimp only [cocone]
    rw [Category.assoc, ← x.naturality j.hom, ← Category.assoc]
    congr 1
    dsimp [loc]
    haveI : HasColimit (CostructuredArrow.map j.hom ⋙ diagram ι F k) := I _
    erw [colimit.ι_pre (diagram ι F k) (CostructuredArrow.map j.hom)]
    congr
    rcases j with ⟨_, ⟨⟩, _⟩
    simp only [CostructuredArrow.map_mk, Category.id_comp]
    rfl
  right_inv := by aesop_cat
set_option linter.uppercaseLean3 false in
  #align category_theory.Lan.equiv CategoryTheory.Lan.equiv

end Lan

/-- The left Kan extension of a functor. -/
@[simps!]
def lan [∀ X, HasColimitsOfShape (CostructuredArrow ι X) D] : (S ⥤ D) ⥤ L ⥤ D :=
  Adjunction.leftAdjointOfEquiv (fun F G => Lan.equiv ι F G) (by {
    intros X' X Y f g
    ext
    simp [Lan.equiv] })
set_option linter.uppercaseLean3 false in
  #align category_theory.Lan CategoryTheory.lan

namespace Lan

variable (D)

/-- The adjunction associated to `Lan`. -/
def adjunction [∀ X, HasColimitsOfShape (CostructuredArrow ι X) D] :
    lan ι ⊣ (whiskeringLeft _ _ D).obj ι :=
  Adjunction.adjunctionOfEquivLeft _ _
set_option linter.uppercaseLean3 false in
  #align category_theory.Lan.adjunction CategoryTheory.Lan.adjunction

theorem coreflective [Full ι] [Faithful ι] [∀ X, HasColimitsOfShape (CostructuredArrow ι X) D] :
    IsIso (adjunction D ι).unit := by
  suffices : ∀ (X : S ⥤ D), IsIso (NatTrans.app (adjunction D ι).unit X)
  · apply NatIso.isIso_of_isIso_app
  intro F
  suffices : ∀ (X : S), IsIso (NatTrans.app (NatTrans.app (adjunction D ι).unit F) X)
  · apply NatIso.isIso_of_isIso_app
  intro X
  dsimp [adjunction, equiv]
  simp only [Category.comp_id]
  exact
    IsIso.of_iso
      ((colimit.isColimit _).coconePointUniqueUpToIso
          (colimitOfDiagramTerminal CostructuredArrow.mkIdTerminal _)).symm
set_option linter.uppercaseLean3 false in
  #align category_theory.Lan.coreflective CategoryTheory.Lan.coreflective

end Lan

end CategoryTheory


import for_mathlib.universal_delta_functor.basic
import for_mathlib.derived.les3
import for_mathlib.derived.les_facts
import for_mathlib.derived.Ext_lemmas

open category_theory
universes v u
variables {A : Type u} [category.{v} A] [abelian A]

noncomputable theory

-- move me
/-- Get an SES in `A` from a SES in `Aᵒᵖ`. -/
def short_exact_sequence.unop (S : short_exact_sequence Aᵒᵖ) : short_exact_sequence A :=
{ fst := S.trd.unop,
  snd := S.snd.unop,
  trd := S.fst.unop,
  f := S.g.unop,
  g := S.f.unop,
  mono' := infer_instance,
  epi' := infer_instance,
  exact' := S.exact'.unop }

-- move me
lemma short_exact_sequence.short_exact (S : short_exact_sequence A) :
  short_exact S.f S.g :=
{ exact := S.exact' }

variables (A) [enough_projectives A]

/-- `Ext' i (-, B)` as a δ-functor. -/
def Ext_δ_functor (B : A) : Aᵒᵖ ⥤δ Ab.{v} :=
{ F := λ i, (Ext' i).flip.obj B,
  additive := infer_instance,
  δ := λ n,
  { app := λ S, by apply
      Ext'_δ B (short_exact_sequence.short_exact $ short_exact_sequence.unop S) n,
    naturality' := begin
      intros S T f,
      dsimp only [functor.comp_map],
      have := Ext'_δ_natural _ _ _ _ ((short_exact_sequence.Trd Aᵒᵖ).map f).unop _
        ((short_exact_sequence.Fst Aᵒᵖ).map f).unop _ _ B
        (short_exact_sequence.short_exact $ short_exact_sequence.unop T)
        (short_exact_sequence.short_exact $ short_exact_sequence.unop S) n,
      dsimp only [quiver.hom.op_unop] at this,
      exact this,
      exact f.snd.unop,
      dsimp only [short_exact_sequence.unop, ← unop_comp], rw f.sq2, refl,
      dsimp only [short_exact_sequence.unop, ← unop_comp], rw ← f.sq1, refl,
    end },
  mono := begin
    intros S,
    let e := bounded_derived_category.Ext'_zero_flip_iso A B,
    let t := _, change mono t,
    have ht : t = (e.hom.app _) ≫ category_theory.functor.map _ S.f ≫ (e.inv.app _),
    { dsimp [t],
      erw ← e.hom.naturality_assoc,
      rw [← nat_trans.comp_app, iso.hom_inv_id, nat_trans.id_app, category.comp_id],
      refl },
    rw ht, clear ht t,
    apply_with mono_comp { instances := ff }, apply_instance,
    apply_with mono_comp { instances := ff }, swap, apply_instance,
    apply concrete_category.mono_of_injective, intros a b h,
    dsimp at h,
    rwa ← cancel_epi S.f.unop,
  end,
  exact' := begin
    intros n S,
    have := (short_exact.Ext'_five_term_exact_seq B
      (short_exact_sequence.short_exact $ short_exact_sequence.unop S) n).extract 0 2,
    rw exact_iff_exact_seq, exact this,
  end,
  exact_δ := begin
    intros n S,
    have := (short_exact.Ext'_five_term_exact_seq B
      (short_exact_sequence.short_exact $ short_exact_sequence.unop S) n).extract 1 2,
    rw exact_iff_exact_seq, exact this,
  end,
  δ_exact := begin
    intros n S,
    have := (short_exact.Ext'_five_term_exact_seq B
      (short_exact_sequence.short_exact $ short_exact_sequence.unop S) n).extract 2 3,
    rw exact_iff_exact_seq, exact this,
  end }

.

instance (B : A) : delta_functor.tohoku.effaceable (Ext_δ_functor A B) :=
begin
  constructor, intros X n,
  let P := projective.over X.unop,
  let π : P ⟶ X.unop := projective.π _,
  constructor,
  refine ⟨_,π.op,_⟩,
  apply limits.is_zero.eq_of_tgt,
  apply bounded_derived_category.Ext'_is_zero_of_projective,
  apply_instance,
  norm_cast,
  exact nat.succ_pos n,
end

instance (B : A) : delta_functor.universal (Ext_δ_functor A B) :=
delta_functor.universal_of_effaceable _


import category_theory.limits.limits
import category_theory.limits.shapes
import category_theory.yoneda
import category_theory.opposites
import category_theory.types
import category_theory.limits.types

run_cmd mk_simp_attr `PRODUCT    -----  BOF BOF
meta def PRODUCT_CAT  : tactic unit :=
`[  try {simp only with PRODUCT}]
run_cmd add_interactive [`PRODUCT_CAT]

universes v u
open category_theory
open category_theory.limits
open category_theory.category
open opposite
namespace lem
variables {C : Type u}
variables [𝒞 : category.{v} C]
variables  [has_binary_products.{v} C][has_terminal.{v} C]
include 𝒞
attribute [PRODUCT] category.assoc category.id_comp category.comp_id
@[PRODUCT] lemma prod_left_def {X Y : C} : limit.π (pair X Y) walking_pair.left = limits.prod.fst := rfl
@[PRODUCT] lemma prod_right_def {X Y : C} : limit.π (pair X Y) walking_pair.right = limits.prod.snd := rfl
lemma prod.hom_ext {A X Y : C} {a b : A ⟶ X ⨯ Y} (h1 : a ≫ limits.prod.fst = b ≫ limits.prod.fst) (h2 : a ≫ limits.prod.snd = b ≫ limits.prod.snd) : a = b :=
begin
  apply limit.hom_ext,
  rintros (_ | _),
  rw prod_left_def,
  exact h1,
  rw prod_right_def,
  exact h2,
end
@[PRODUCT]lemma prod.lift_fst {Y A B : C} (f : Y ⟶ A) (g : Y ⟶ B) : prod.lift f g ≫ category_theory.limits.prod.fst = f :=
limit.lift_π (binary_fan.mk f g) _

@[PRODUCT]lemma prod.lift_snd {Y A B : C} (f : Y ⟶ A) (g : Y ⟶ B) : prod.lift f g ≫ category_theory.limits.prod.snd = g :=
limit.lift_π (binary_fan.mk f g) _

end lem

notation f ` ⊗ `:20 g :20 := category_theory.limits.prod.map f g  ---- 20
notation  `T`C :20 := (terminal C)
notation   `T`X : 20 := (terminal.from X)
notation f ` | `:20 g :20 :=  prod.lift f g
notation `π1` := limits.prod.fst
notation `π2` := limits.prod.snd

variables {C : Type u}
variables [𝒞 : category.{v} C]
variables [has_binary_products.{v} C][has_terminal.{v} C]
include 𝒞
variables (X :C)
open lem
/-
     π notation for projection
-/
@[PRODUCT]lemma ex_1 {Y A B : C} (f : Y ⟶ A) (g : Y ⟶ B) : ( f | g) ≫ π1 = f  :=   prod.lift_fst f g
/-
     we can type π : A ⨯ B ⟶ B if we need
-/
@[PRODUCT]lemma ex_2 {Y A B : C} (f : Y ⟶ A) (g : Y ⟶ B) : ( f | g) ≫ (π2 : A ⨯ B ⟶ B) = g := prod.lift_snd f g

@[PRODUCT]lemma ex_3 {A X Y : C} {a b : A ⟶ X ⨯ Y} (h1 : a ≫ π1  = b ≫ π1 ) (h2 : a ≫ π2  = b ≫ π2)  : a = b :=  prod.hom_ext h1 h2

@[PRODUCT]lemma prod.left_composition{Z' Z A B : C}(h : Z' ⟶ Z)(f : Z ⟶ A)(g : Z ⟶ B)  :
               h ≫ (f | g)  = (h ≫ f | h ≫ g) :=
begin
     apply prod.hom_ext,   --- Le right member is of the form ( | )  composition π1 π2
     PRODUCT_CAT,  PRODUCT_CAT,  --- here assoc
     -- rw assoc,
     -- rw prod.lift_fst,
     -- rw prod.lift_fst,
     -- rw prod.lift_snd,
     -- rw assoc,
     -- rw prod.lift_snd,
end

@[PRODUCT]lemma prod.map_first{X Y Z W : C}(f  : X ⟶ Y)(g  : Z ⟶ W) :  (f ⊗ g) ≫ (π1 : Y ⨯ W ⟶ Y) = π1  ≫ f :=  begin
     exact limit.map_π (map_pair f g) walking_pair.left,
end
@[PRODUCT]lemma prod.map_second{X Y Z W : C}(f  : X ⟶ Y)(g  : Z ⟶ W) :  (f ⊗ g) ≫ π2 = π2 ≫ g :=  begin
     exact limit.map_π (map_pair f g) walking_pair.right,
end
@[PRODUCT]lemma  prod.otimes_is_prod {X Y Z W : C}(f  : X ⟶ Y)(g  : Z ⟶ W) : (f ⊗ g) = ( π1  ≫ f | π2 ≫ g ) := begin
     apply prod.hom_ext,
     PRODUCT_CAT, PRODUCT_CAT,
     -- rw prod.lift_fst,
     -- rw prod.map_first,
     -- rw prod.lift_snd,
     -- rw prod.map_second,
end
-- notation π1`(`X `x` Y`)` := (limits.prod.fst : X⨯Y ⟶ X)
@[PRODUCT]lemma prod.map_ext{X Y Z W : C}(f1 f2  : X ⟶ Y)(g1 g2  : Z ⟶ W) :  (f1 ⊗ g1) = (f2 ⊗ g2) →
(π1 : X ⨯ Z ⟶ X) ≫ f1 = (π1 : X ⨯ Z ⟶ X)  ≫ f2 := λ certif, begin
     iterate 2 {rw prod.otimes_is_prod at certif},
     rw ← prod.map_first ( f1)  (g1),
     rw ← prod.map_first ( f2)  (g2),
     iterate 2 {rw prod.otimes_is_prod},
     rw certif,
end
@[PRODUCT]lemma destruction {X Y Z : C} (f :  Y ⟶ X) (g : X ⟶ Z ) :
     (f | 𝟙 Y) ≫ (g ⊗ (𝟙 Y)) = (f ≫ g | 𝟙 Y) := begin
     apply prod.hom_ext,
     -- PRODUCT_CAT,PRODUCT_CAT,     ---------------------- PROBLEME With the tatict HEEEEEEERRRRRRE
     rw [prod.lift_fst],
     rw  assoc,
     rw prod.map_first,
     rw ← assoc,               ----- ← assoc here  Problem ?
     rw prod.lift_fst,
     tidy, -- super - power tidy
end

def Y (R : C)(A :C) := (yoneda.obj A).obj (op R)
def Y_ (R : C) {A B : C}(φ : A ⟶ B) := ((yoneda.map φ).app (op R) : Y R A ⟶ Y R B)
-- Good notation for yoneda stuff :
-- We fix V : C and we denote by
-- R[X] := yoneda.obj X).obj (op R) and φ : A  ⟶ B (in C) R ⟦  φ ⟧   : R[A] → R[B]  in type v
notation R`[`A`]`:20 := Y R A  -- notation ??
notation R`<`φ`>` :20   := Y_ R φ  --
def Yoneda_preserve_product (Y : C)(A B : C) :
     Y[A ⨯ B] ≅ Y[A] ⨯ Y[B] :=
{ hom := prod.lift
    (λ f, f ≫ π1)
    (λ f, f ≫ π2),
  inv := λ f : (Y ⟶ A) ⨯ (Y ⟶ B),
    (prod.lift
      ((@category_theory.limits.prod.fst _ _ (Y ⟶ A) (Y ⟶ B) _ : ((Y ⟶ A) ⨯ (Y ⟶ B)) → (Y ⟶ A)) f)
      ((@category_theory.limits.prod.snd _ _ (Y ⟶ A) _ _ : ((Y ⟶ A) ⨯ (Y ⟶ B)) → (Y ⟶ B)) f : Y ⟶ B)),
  hom_inv_id' := begin
    ext f,
    cases j,
    { simp, refl},
    { simp, refl}
  end,
  inv_hom_id' := begin
    apply lem.prod.hom_ext,
    { rw assoc, rw lem.prod.lift_fst, obviously},
    { rw assoc, rw lem.prod.lift_snd, obviously}
  end
}
--- Here it just sugar
@[PRODUCT]lemma yoneda_sugar.composition (R : C) {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) : R < f ≫ g > =( R< f >) ≫ (R < g >)
 :=  begin
     unfold Y_,
     simp,
 end
def yoneda_sugar.conv {R : C}{A : C}(g : R[A]) : R ⟶ A := g
def yoneda_sugar.prod (R : C)(A B : C) : R[A ⨯ B] ≅ R[A] ⨯ R[B] := begin
     exact Yoneda_preserve_product R A B,
end
@[PRODUCT]lemma yoneda_sugar.prod.hom (R : C)(A B : C) :
     (yoneda_sugar.prod R A B).hom =  (R < (limits.prod.fst : A ⨯ B ⟶ A) > | R < (limits.prod.snd : A ⨯ B ⟶ B)> ) := rfl

@[PRODUCT]lemma yoneda_sugar.prod.first (R : C)(A B : C) :
 (yoneda_sugar.prod R A B).hom ≫ limits.prod.fst = (R < limits.prod.fst >) :=
 begin
     exact rfl,
 end
 @[PRODUCT]lemma yoneda_sugar.prod.hom_inv (R : C)(A B : C) :
     (yoneda_sugar.prod R A B).hom ≫ (yoneda_sugar.prod R A B).inv = 𝟙 (R[ A ⨯ B]) :=
     (Yoneda_preserve_product R A B).hom_inv_id'
 @[PRODUCT]lemma yoneda_sugar.prod.inv_hom (R : C)(A B : C) :
     (yoneda_sugar.prod R A B).inv ≫ (yoneda_sugar.prod R A B).hom = 𝟙 ( R [A]  ⨯ R[B]) :=
     (Yoneda_preserve_product R A B).inv_hom_id'
 @[PRODUCT]lemma yoneda_sugar.prod.second (R : C)(A B : C) :
  (yoneda_sugar.prod R A B).hom ≫ limits.prod.snd = (R < limits.prod.snd >) := rfl

@[PRODUCT]lemma yoneda_sugar.id (R : C)(A : C) : R < 𝟙 A > = 𝟙 ( R [A] ) := begin
     funext,
     exact comp_id C g,
     -- have T : ((yoneda.map (𝟙 A)).app (op R)) g = (g ≫ (𝟙 A)),
end
lemma yoneda_sugar_prod (R : C)(A B : C)(X :C)(f : X ⟶ A)(g : X ⟶ B) :
      R < (f | g) > ≫ (yoneda_sugar.prod R A B).hom  =  (R < f > | R < g > ) :=  -- the  ≫  is  :/
     begin
          PRODUCT_CAT,
          -- rw  yoneda_sugar.prod.hom R A B,
          -- rw prod.left_composition,
          iterate 2 {rw ← yoneda_sugar.composition},   -- rw ← is the problem ?
          rw lem.prod.lift_fst,
          rw lem.prod.lift_snd,
     end
@[PRODUCT]lemma yoneda_sugar_prod_inv (R : C)(A B : C)(X :C)(f : X ⟶ A)(g : X ⟶ B) :
     R < (f | g) >   =  (R < f > | R < g > ) ≫ (yoneda_sugar.prod R A B).inv :=
     begin
          PRODUCT_CAT,  -- noting
          rw ← yoneda_sugar_prod,
          rw assoc,
          rw yoneda_sugar.prod.hom_inv,
          exact rfl,
     end
lemma  yoneda_sugar.otimes (R : C){Y Z K :C}(f : X ⟶ Y )(g : Z ⟶ K) :
 ( R < (f ⊗ g) > ) = (yoneda_sugar.prod  _ _ _).hom ≫ ((R<f>) ⊗ R<g>) ≫ (yoneda_sugar.prod _ _ _ ).inv := begin
     PRODUCT_CAT,
     -- iterate 2 {rw prod.otimes_is_prod},
     -- rw  yoneda_sugar.prod.hom,
     -- iterate 1 {rw yoneda_sugar_prod_inv},
     rw ← assoc,
     rw prod.left_composition,
     rw ← assoc,
     rw prod.lift_fst,
     rw ← assoc,
     rw prod.lift_snd,
     -- rw yoneda_sugar.composition,
     -- rw yoneda_sugar.composition,
end
@[PRODUCT]lemma yonega_sugar.one_otimes (R :C)(X Y Z: C) (f : X ⟶ Y) :
 (((yoneda_sugar.prod R Z X).inv) ≫ (R <(𝟙 Z ⊗ f ) > ) ≫ (yoneda_sugar.prod R Z Y).hom) = (𝟙 (R[Z]) ⊗ R < f >) := begin
     rw yoneda_sugar.otimes,
     iterate 3 {rw ← assoc},
     rw yoneda_sugar.prod.inv_hom,
     rw id_comp,
     rw assoc,
     rw yoneda_sugar.prod.inv_hom,
     rw ← yoneda_sugar.id,
     simp,
 end
lemma yonega_sugar.one_otimes' (R :C)(X Y Z: C) (f : X ⟶ Y) :
 ( (R <(𝟙 Z ⊗ f ) > ) ≫ (yoneda_sugar.prod R Z Y).hom) = ((yoneda_sugar.prod R Z X).hom) ≫ (𝟙 (R[Z]) ⊗ R < f >) := begin
     iterate 2{ rw yoneda_sugar.prod.hom},
     rw prod.left_composition,
     iterate 2{ rw ← yoneda_sugar.composition},
     rw prod.map_first,
     rw prod.map_second,
     rw comp_id,
     rw prod.otimes_is_prod,rw prod.left_composition,rw ← assoc,
     rw prod.lift_fst,rw ←  assoc,rw prod.lift_snd,rw comp_id,
     rw yoneda_sugar.composition,
 end


import .core

namespace tts ------------------------------------------------------------------
namespace sch ------------------------------------------------------------------
variables {V : Type} [_root_.decidable_eq V] -- Type of variable names
variables {ts : list (typ V)} -- Lists of types
variables {s : sch V} -- Type schemes

-- A locally-closed schema opened with a list of types is locally-closed if all
-- types are locally-closed.
theorem lc_open_typs
  (ls : lc s)
  (ln_s_eq_ts : s.arity = ts.length)
  (lts : ∀ t ∈ ts, typ.lc t) :
  typ.lc (open_typs ts s) :=
begin
  cases ls with L ls,
  let L' := fv s ∪ typ.fv_list ts ∪ L,
  let FL' := ((freshL.tagged s.vars_nodup).pgen L').1,
  have ndL' : FL'.nodup := (freshL.tagged s.vars_nodup).pgen_nodup L',
  have ln_FL'_eq_s : FL'.length = s.arity :=
    freshL.tagged_length_eq L' s.vars_nodup,
  have nm_s_ts : ∀ x ∈ FL', x ∉ typ.fv s.type ∪ typ.fv_list ts :=
    λ _ h, ((freshL.tagged s.vars_nodup).pgen_mem_union h).1,
  have nm_L : ∀ x ∈ FL', x ∉ L :=
    λ _ h, ((freshL.tagged s.vars_nodup).pgen_mem_union h).2,
  have ln_FL'_eq_ts : FL'.length = ts.length := ln_FL'_eq_s.trans ln_s_eq_ts,
  rw [open_typs, typ.subst_list_intro ndL' ln_FL'_eq_ts nm_s_ts lts],
  exact typ.subst_list_lc ln_FL'_eq_ts lts (ls ndL' ln_FL'_eq_s nm_L)
end

end /- namespace -/ sch --------------------------------------------------------
end /- namespace -/ tts --------------------------------------------------------


namespace Nat

theorem example1 (x y z : Nat) : x * y + z = x * y + z :=
  rfl

theorem example2 (x y : Nat) (h : y = x + 7) : 2 * y = 2 * (x + 7) :=
  rw

end Nat


def twice : Nat → Nat := λ n => 2*n

def foo1 : (λ x : Nat => id (twice (id x))) = twice := by
  conv in (id _) =>
    trace_state
    conv =>
      enter [1,1]
      trace_state
      simp
      trace_state
    trace_state  -- `id (twice x)`

theorem foo2 (y : Nat) : (fun x => x + y = 0) = (fun x => False) := by
  conv =>
    trace_state
    conv =>
      lhs
      trace_state
      intro x
      rw [Nat.add_comm]
      trace_state
    trace_state
  trace_state
  sorry


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import tactic
import measure_theory.measurable_space
import measure_theory.integration
import measure_theory.borel_space
import measure_theory.lebesgue_measure
import topology.metric_space.basic
import topology.instances.real
import topology.instances.ennreal
import order.liminf_limsup
import portmanteau_limsup_lemmas
import portmanteau_proba_lemmas
import portmanteau_topological_lemmas
import portmanteau_metric_lemmas
import portmanteau_definitions

noncomputable theory
open set
open classical
open measure_theory
open measurable_space
open metric_space
open metric
open real
open borel_space
open filter
open order
open tactic.interactive
open_locale topological_space ennreal big_operators classical

namespace portmanteau

section portmanteau_borel_condition_implies_closed_condition

variables {α : Type} [metric_space α]

notation `borel_measure`(α) := @measure_theory.measure α (borel α)
notation `borel_set`(α) E := (borel α).measurable_set' E

lemma exists_infdist_level_sets_of_zero_measure_with_small_level
  (a b : ℝ) (a_pos : 0 < a) (a_lt_b : a < b)
  (μ : borel_measure(α)) [hfin : @probability_measure α (borel(α)) μ]
  (F : set α) :
    {δ : ℝ | δ ∈ Ioo a b ∧ μ {x : α | ((inf_dist x F) = δ) } = 0 }.nonempty :=
begin
  -- TODO: It seems more appropriate to do this with uncountable cardinality,
  -- but I didn't find the relevant lemmas... This is now done instead using the
  -- stronger condition of positive Lebesgue measure. Either one works, but the
  -- former would arguably be more natural and elegant.
  have bad_small := countably_many_infdist_level_sets_of_positive_measure μ F ,
  set B' := {δ : ℝ | δ > 0 ∧ μ {x : α | ((inf_dist x F) = δ) } > 0 } with hB' ,
  set B := B' ∩ (Ioo a b) with hB ,
  have sub1 : B ⊆ B' := inter_subset_left B' (Ioo a b) ,
  have sub2 : B ⊆ (Ioo a b) := inter_subset_right B' (Ioo a b) ,
  have ctble_B : B.countable := countable.mono sub1 bad_small ,
  have mble_B : measurable_set B := countable.measurable_set ctble_B ,
  have null_B : (volume : measure ℝ) B = 0 ,
  { apply set.countable.measure_zero ctble_B ,
    exact real.has_no_atoms_volume , } ,
  have Ioo_large : (volume : measure ℝ) (Ioo a b) > 0 ,
  { rw @volume_Ioo a b ,
    simp only [a_lt_b, ennreal.of_real_pos, gt_iff_lt, sub_pos] , } ,
  have compl : {δ : ℝ | δ ∈ Ioo a b ∧ μ {x : α | ((inf_dist x F) = δ) } = 0 } = (Ioo a b) \ B ,
  { apply le_antisymm ,
    { intros δ hδ ,
      have notbad : δ ∉ B ,
      { by_contradiction pretendbad ,
        exact ne_of_gt pretendbad.1.2 hδ.2 , } ,
      exact ⟨ hδ.1 , notbad ⟩ , } ,
    { intros δ hδ ,
      have δ_in_Ioo : δ ∈ Ioo a b := mem_of_mem_diff hδ ,
      have δ_pos : 0 < δ := lt_trans a_pos δ_in_Ioo.1 ,
      have good : δ ∉ B := not_mem_of_mem_diff hδ ,
      have good' : δ ∉ B' ,
      { by_contradiction nogood' ,
        have in_B : δ ∈ B := mem_inter nogood' δ_in_Ioo ,
        contradiction , } ,
      have key : μ {x : α | inf_dist x F = δ} = 0 ,
      { by_contradiction hcontra ,
        have pos_meas : 0 < μ {x : α | inf_dist x F = δ} ,
        { have meas_ne_zero : μ {x : α | inf_dist x F = δ} ≠ 0 := hcontra ,
          have meas_ge_zero : 0 ≤ μ {x : α | inf_dist x F = δ} := zero_le _ ,
          apply lt_iff_le_and_ne.mpr ⟨meas_ge_zero , meas_ne_zero.symm⟩ , } ,
        exact good' ⟨δ_pos , pos_meas⟩ , } ,
      exact ⟨δ_in_Ioo , key⟩ , } ,
  } ,
  rw compl ,
  clear compl hB ,
  have Ioo_minus_large : (volume : measure ℝ) ((Ioo a b) \ B) > 0 ,
  { suffices : (volume : measure ℝ) ((Ioo a b) \ B) = (volume : measure ℝ) (Ioo a b) ,
    { rwa this , } ,
    have mdiff := @measure_diff ℝ _ (volume : measure ℝ) _ _ sub2 (measurable_set_Ioo) mble_B (by simp [null_B]) ,
    rwa [mdiff, null_B] ,
    simp only [ennreal.sub_zero] , } ,
  by_contradiction hcontra ,
  have emp : ((Ioo a b) \ B) = ∅ := set.not_nonempty_iff_eq_empty.mp hcontra ,
  rw emp at Ioo_minus_large ,
  simp only [measure_empty, ennreal.not_lt_zero, gt_iff_lt] at Ioo_minus_large ,
  contradiction ,
end

private lemma reciprocal_lt (n : ℕ) : (1/(n+2) : ℝ) < (1/(n+1) : ℝ) :=
begin
  have decr : ∀ (x y : ℝ) , 0 < x → x < y → 1/y < 1/x ,
  { intros x y ,
    exact one_div_lt_one_div_of_lt , } ,
  have pos : 0 < ((n+1) : ℝ) := nat.cast_add_one_pos n ,
  have lt' : (n+1) < (n+2) := lt_add_one (n+1) ,
  have lt : (n+1 : ℝ) < (n+2 : ℝ) ,
  {simp at * , norm_cast , exact dec_trivial , } ,
  exact decr (n+1) (n+2) pos lt ,
end

private def seq_of_good_radii
  (μ : borel_measure(α)) [hfin : @probability_measure α (borel(α)) μ]
  (F : set α) : ℕ → ℝ :=
    λ n , classical.some (exists_infdist_level_sets_of_zero_measure_with_small_level (1/(n+2) : ℝ) ((1/(n+1)) : ℝ) (by tidy) (reciprocal_lt n) μ F)

private lemma seq_of_good_radii_decr
  (μ : borel_measure(α)) [hfin : @probability_measure α (borel(α)) μ]
  (F : set α) : is_decreasing_seq (seq_of_good_radii μ F) :=
begin
  set s := (seq_of_good_radii μ F) with hs ,
  intros n m hnm ,
  by_cases h : n = m ,
  { rw h , } ,
  { have n_succ_le_m : n+1 ≤ m := nat.succ_le_iff.mpr ((ne.le_iff_lt h).mp hnm) ,
    have key_le : (1/(m+1) : ℝ) ≤ (1/(n+2) : ℝ) ,
    { have n_succ_le_m' : (n+2 : ℝ) ≤ (m+1 : ℝ) ,
      { norm_cast ,
        exact nat.succ_le_succ n_succ_le_m , } ,
      apply one_div_le_one_div_of_le _ n_succ_le_m' ,
      norm_cast ,
      exact dec_trivial , } ,
    have lbn : (1/(n+2) : ℝ) < s n
      := (some_spec (exists_infdist_level_sets_of_zero_measure_with_small_level (1/(n+2) : ℝ) ((1/(n+1)) : ℝ) (by tidy) (reciprocal_lt n) μ F)).1.1 ,
    have ubm : s m < (1/(m+1) : ℝ)
      := (some_spec (exists_infdist_level_sets_of_zero_measure_with_small_level (1/(m+2) : ℝ) ((1/(m+1)) : ℝ) (by tidy) (reciprocal_lt m) μ F)).1.2 ,
    have key := lt_trans (lt_of_lt_of_le ubm key_le) lbn ,
    exact le_of_lt key , } ,
end

private lemma seq_of_good_radii_pos
  (μ : borel_measure(α)) [hfin : @probability_measure α (borel(α)) μ]
  (F : set α) :
    ∀ (n : ℕ) , 0 < (seq_of_good_radii μ F n) :=
begin
  set s := (seq_of_good_radii μ F) with hs ,
  intros n ,
  have lbn : (1/(n+2) : ℝ) < s n
    := (some_spec (exists_infdist_level_sets_of_zero_measure_with_small_level (1/(n+2) : ℝ) ((1/(n+1)) : ℝ) (by tidy) (reciprocal_lt n) μ F)).1.1 ,
  have pos : 0 < (1/(n+2) : ℝ) ,
  { simp only [one_div , inv_pos] ,
    norm_cast,
    exact dec_trivial , } ,
  linarith ,
end

private lemma seq_of_good_radii_tendsto
  (μ : borel_measure(α)) [hfin : @probability_measure α (borel(α)) μ]
  (F : set α) : lim_R (seq_of_good_radii μ F) 0 :=
begin
  have posseq := seq_of_good_radii_pos μ F ,
  set s := (seq_of_good_radii μ F) with hs ,
  have ub : ∀ (n : ℕ) , s(n) < 1/(n+1)
    := λ n , (some_spec (exists_infdist_level_sets_of_zero_measure_with_small_level (1/(n+2) : ℝ) ((1/(n+1)) : ℝ) (by tidy) (reciprocal_lt n) μ F)).1.2 ,
  apply squeeze_zero (λ n , le_of_lt (posseq n)) (λ n , le_of_lt (ub n)) ,
  exact tendsto_one_div_add_at_top_nhds_0_nat ,
end

private lemma seq_of_good_radii_null
  (μ : borel_measure(α)) [hfin : @probability_measure α (borel(α)) μ]
  (F : set α) :
  ∀ (n : ℕ) , μ {x : α | inf_dist x F = seq_of_good_radii μ F n } = 0 :=
begin
  set s := (seq_of_good_radii μ F) with hs ,
  intros n ,
  exact (some_spec (exists_infdist_level_sets_of_zero_measure_with_small_level (1/(n+2) : ℝ) ((1/(n+1)) : ℝ) (by tidy) (reciprocal_lt n) μ F)).2 ,
end

lemma portmanteau_borel_imp_closed
  (μseq : ℕ → @measure_theory.measure α (borel α))
  (μseq_fin : ∀ (n : ℕ) , @probability_measure α (borel(α)) (μseq(n)))
  (μ : @measure_theory.measure α (borel α)) (μ_fin : @probability_measure α (borel(α)) μ) :
  portmanteau_borel μseq μ → portmanteau_closed μseq μ :=
begin
  intros hborcond F hFclos ,
  by_cases emp : F = ∅ ,
  { rw emp ,
    simp only [measure_empty, nonpos_iff_eq_zero] ,
    exact limsup_const 0 , } ,
  have nonemp : F.nonempty := ne_empty_iff_nonempty.mp emp ,
  set δseq := (seq_of_good_radii μ F) with hs ,
  suffices : ∀ (c : ennreal) , μ(F) < c → limsup_enn (λ n , (μseq n)(F)) ≤ c ,
  { exact le_of_forall_le_of_dense this , } ,
  intros c hc ,
  set thick := λ (j : ℕ) , thickening_o (δseq(j)) F with hthick ,
  have closeenough : ∃ (j : ℕ) , μ (thick(j)) ≤ c ,
  { have approx := closed_set_borel_proba_by_thickenings μ F hFclos nonemp
      δseq (seq_of_good_radii_pos μ F) (seq_of_good_radii_decr μ F) (seq_of_good_radii_tendsto μ F) ,
    have near := approx (Iic_mem_nhds hc) ,
    simp at near ,
    cases near with j hj ,
    use j ,
    apply hj j (by refl) , } ,
  cases closeenough with j hj ,
  have δpos : δseq(j) > 0 := seq_of_good_radii_pos μ F j ,
  have nullfrontier : μ (frontier (thick(j))) = 0 ,
  { have meas_mono := @measure_mono α (borel(α)) μ _ _ (frontier_thickening_o F (δseq(j)) δpos) ,
    rw (seq_of_good_radii_null μ F j) at meas_mono ,
    rw hthick ,
    apply le_antisymm ,
    { exact meas_mono , } ,
    simp only [zero_le] , } ,
  have openthick : is_open (thick j) := is_open_thickening_o ,
  have limthick := hborcond (thick j) (open_imp_borel openthick) (nullfrontier) ,
  have limsupthick := lim_eq_limsup_ennreal (limthick) ,
  have key_le : ∀ (n : ℕ) , (μseq(n))(F) ≤ (μseq(n))(thick j) ,
  { intros n,
    rw hthick ,
    have sub := closure_subset_thickening_o (δseq(j)) δpos F ,
    rw closure_eq_iff_is_closed.mpr hFclos at sub ,
    exact @measure_mono α (borel(α)) (μseq(n)) _ _ sub , } ,
  have limsup_le := limsup_enn_mono key_le ,
  rw limsupthick at limsup_le ,
  exact le_trans limsup_le hj ,
end

end portmanteau_borel_condition_implies_closed_condition

end portmanteau


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.closed.cartesian
import Mathlib.category_theory.limits.preserves.shapes.binary_products
import Mathlib.category_theory.adjunction.fully_faithful
import Mathlib.PostPort

universes v u u' l

namespace Mathlib

/-!
# Cartesian closed functors

Define the exponential comparison morphisms for a functor which preserves binary products, and use
them to define a cartesian closed functor: one which (naturally) preserves exponentials.

Define the Frobenius morphism, and show it is an isomorphism iff the exponential comparison is an
isomorphism.

## TODO
Some of the results here are true more generally for closed objects and for closed monoidal
categories, and these could be generalised.

## References
https://ncatlab.org/nlab/show/cartesian+closed+functor
https://ncatlab.org/nlab/show/Frobenius+reciprocity

## Tags
Frobenius reciprocity, cartesian closed functor

-/

namespace category_theory

/--
The Frobenius morphism for an adjunction `L ⊣ F` at `A` is given by the morphism

    L(FA ⨯ B) ⟶ LFA ⨯ LB ⟶ A ⨯ LB

natural in `B`, where the first morphism is the product comparison and the latter uses the counit
of the adjunction.

We will show that if `C` and `D` are cartesian closed, then this morphism is an isomorphism for all
`A` iff `F` is a cartesian closed functor, i.e. it preserves exponentials.
-/
def frobenius_morphism {C : Type u} [category C] {D : Type u'} [category D] [limits.has_finite_products C] [limits.has_finite_products D] (F : C ⥤ D) {L : D ⥤ C} (h : L ⊣ F) (A : C) : functor.obj limits.prod.functor (functor.obj F A) ⋙ L ⟶ L ⋙ functor.obj limits.prod.functor A :=
  limits.prod_comparison_nat_trans L (functor.obj F A) ≫
    whisker_left L (functor.map limits.prod.functor (nat_trans.app (adjunction.counit h) A))

/--
If `F` is full and faithful and has a left adjoint `L` which preserves binary products, then the
Frobenius morphism is an isomorphism.
-/
protected instance frobenius_morphism_iso_of_preserves_binary_products {C : Type u} [category C] {D : Type u'} [category D] [limits.has_finite_products C] [limits.has_finite_products D] (F : C ⥤ D) {L : D ⥤ C} (h : L ⊣ F) (A : C) [limits.preserves_limits_of_shape (discrete limits.walking_pair) L] [full F] [faithful F] : is_iso (frobenius_morphism F h A) :=
  nat_iso.is_iso_of_is_iso_app (frobenius_morphism F h A)

/--
The exponential comparison map.
`F` is a cartesian closed functor if this is an iso for all `A`.
-/
def exp_comparison {C : Type u} [category C] {D : Type u'} [category D] [limits.has_finite_products C] [limits.has_finite_products D] (F : C ⥤ D) [cartesian_closed C] [cartesian_closed D] [limits.preserves_limits_of_shape (discrete limits.walking_pair) F] (A : C) : exp A ⋙ F ⟶ F ⋙ exp (functor.obj F A) :=
  coe_fn (transfer_nat_trans (exp.adjunction A) (exp.adjunction (functor.obj F A)))
    (iso.inv (limits.prod_comparison_nat_iso F A))

theorem exp_comparison_ev {C : Type u} [category C] {D : Type u'} [category D] [limits.has_finite_products C] [limits.has_finite_products D] (F : C ⥤ D) [cartesian_closed C] [cartesian_closed D] [limits.preserves_limits_of_shape (discrete limits.walking_pair) F] (A : C) (B : C) : limits.prod.map 𝟙 (nat_trans.app (exp_comparison F A) B) ≫ nat_trans.app (ev (functor.obj F A)) (functor.obj F B) =
  inv (limits.prod_comparison F A (functor.obj (exp A) B)) ≫ functor.map F (nat_trans.app (ev A) B) := sorry

theorem coev_exp_comparison {C : Type u} [category C] {D : Type u'} [category D] [limits.has_finite_products C] [limits.has_finite_products D] (F : C ⥤ D) [cartesian_closed C] [cartesian_closed D] [limits.preserves_limits_of_shape (discrete limits.walking_pair) F] (A : C) (B : C) : functor.map F (nat_trans.app (coev A) B) ≫ nat_trans.app (exp_comparison F A) (A ⨯ B) =
  nat_trans.app (coev (functor.obj F A)) (functor.obj F B) ≫
    functor.map (exp (functor.obj F A)) (inv (limits.prod_comparison F A B)) := sorry

theorem uncurry_exp_comparison {C : Type u} [category C] {D : Type u'} [category D] [limits.has_finite_products C] [limits.has_finite_products D] (F : C ⥤ D) [cartesian_closed C] [cartesian_closed D] [limits.preserves_limits_of_shape (discrete limits.walking_pair) F] (A : C) (B : C) : cartesian_closed.uncurry (nat_trans.app (exp_comparison F A) B) =
  inv (limits.prod_comparison F A (functor.obj (exp A) B)) ≫ functor.map F (nat_trans.app (ev A) B) := sorry

/-- The exponential comparison map is natural in `A`. -/
theorem exp_comparison_whisker_left {C : Type u} [category C] {D : Type u'} [category D] [limits.has_finite_products C] [limits.has_finite_products D] (F : C ⥤ D) [cartesian_closed C] [cartesian_closed D] [limits.preserves_limits_of_shape (discrete limits.walking_pair) F] {A : C} {A' : C} (f : A' ⟶ A) : exp_comparison F A ≫ whisker_left F (pre (functor.map F f)) = whisker_right (pre f) F ≫ exp_comparison F A' := sorry

/--
The functor `F` is cartesian closed (ie preserves exponentials) if each natural transformation
`exp_comparison F A` is an isomorphism
-/
class cartesian_closed_functor {C : Type u} [category C] {D : Type u'} [category D] [limits.has_finite_products C] [limits.has_finite_products D] (F : C ⥤ D) [cartesian_closed C] [cartesian_closed D] [limits.preserves_limits_of_shape (discrete limits.walking_pair) F]
where
  comparison_iso : (A : C) → is_iso (exp_comparison F A)

theorem frobenius_morphism_mate {C : Type u} [category C] {D : Type u'} [category D] [limits.has_finite_products C] [limits.has_finite_products D] (F : C ⥤ D) {L : D ⥤ C} [cartesian_closed C] [cartesian_closed D] [limits.preserves_limits_of_shape (discrete limits.walking_pair) F] (h : L ⊣ F) (A : C) : coe_fn
    (transfer_nat_trans_self (adjunction.comp (functor.obj limits.prod.functor A) (exp A) h (exp.adjunction A))
      (adjunction.comp L F (exp.adjunction (functor.obj F A)) h))
    (frobenius_morphism F h A) =
  exp_comparison F A := sorry

/--
If the exponential comparison transformation (at `A`) is an isomorphism, then the Frobenius morphism
at `A` is an isomorphism.
-/
def frobenius_morphism_iso_of_exp_comparison_iso {C : Type u} [category C] {D : Type u'} [category D] [limits.has_finite_products C] [limits.has_finite_products D] (F : C ⥤ D) {L : D ⥤ C} [cartesian_closed C] [cartesian_closed D] [limits.preserves_limits_of_shape (discrete limits.walking_pair) F] (h : L ⊣ F) (A : C) [i : is_iso (exp_comparison F A)] : is_iso (frobenius_morphism F h A) :=
  transfer_nat_trans_self_of_iso (adjunction.comp (functor.obj limits.prod.functor A) (exp A) h (exp.adjunction A))
    (adjunction.comp L F (exp.adjunction (functor.obj F A)) h) (frobenius_morphism F h A)

/--
If the Frobenius morphism at `A` is an isomorphism, then the exponential comparison transformation
(at `A`) is an isomorphism.
-/
def exp_comparison_iso_of_frobenius_morphism_iso {C : Type u} [category C] {D : Type u'} [category D] [limits.has_finite_products C] [limits.has_finite_products D] (F : C ⥤ D) {L : D ⥤ C} [cartesian_closed C] [cartesian_closed D] [limits.preserves_limits_of_shape (discrete limits.walking_pair) F] (h : L ⊣ F) (A : C) [i : is_iso (frobenius_morphism F h A)] : is_iso (exp_comparison F A) :=
  eq.mpr sorry
    (category_theory.transfer_nat_trans_self_iso
      (adjunction.comp (functor.obj limits.prod.functor A) (exp A) h (exp.adjunction A))
      (adjunction.comp L F (exp.adjunction (functor.obj F A)) h) (frobenius_morphism F h A))

/--
If `F` is full and faithful, and has a left adjoint which preserves binary products, then it is
cartesian closed.

TODO: Show the converse, that if `F` is cartesian closed and its left adjoint preserves binary
products, then it is full and faithful.
-/
def cartesian_closed_functor_of_left_adjoint_preserves_binary_products {C : Type u} [category C] {D : Type u'} [category D] [limits.has_finite_products C] [limits.has_finite_products D] (F : C ⥤ D) {L : D ⥤ C} [cartesian_closed C] [cartesian_closed D] [limits.preserves_limits_of_shape (discrete limits.walking_pair) F] (h : L ⊣ F) [full F] [faithful F] [limits.preserves_limits_of_shape (discrete limits.walking_pair) L] : cartesian_closed_functor F :=
  cartesian_closed_functor.mk fun (A : C) => exp_comparison_iso_of_frobenius_morphism_iso F h A


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
Ported by: Heather Macbeth
-/
import Mathlib.Tactic.Monotonicity.Attr
import Mathlib.Tactic.SolveByElim

/-! # Monotonicity tactic

The tactic `mono` applies monotonicity rules (collected through the library by being tagged
`@[mono]`).

The version of the tactic here is a cheap partial port of the `mono` tactic from Lean 3, which had
many more options and features.  It is implemented as a wrapper on top of `solve_by_elim`.

Temporary syntax change: Lean 3 `mono` applied a single monotonicity rule, then applied local
hypotheses and the `rfl` tactic as many times as it could.  This is hard to implement on top of
`solve_by_elim` because the counting system used in the `maxDepth` field of its configuration would
count these as separate steps, throwing off the count in the desired configuration
`maxDepth := 1`.  So instead we just implement a version of `mono` in which monotonicity rules,
local hypotheses and `rfl` are all applied repeatedly until nothing more is applicable.  The syntax
for this in Lean 3 was `mono*`. Both `mono` and `mono*` implement this behavior for now.
-/

open Lean Elab Tactic Parser Tactic
open Mathlib Tactic SolveByElim

namespace Mathlib.Tactic.Monotonicity

/--
`mono` applies monotonicity rules and local hypotheses repetitively.  For example,
```lean
example (x y z k : ℤ)
    (h : 3 ≤ (4 : ℤ))
    (h' : z ≤ y) :
    (k + 3 + x) - y ≤ (k + 4 + x) - z := by
  mono
```
-/
syntax (name := mono) "mono" "*"? (ppSpace mono.side)?
  (" with " (colGt term),+)? (" using " (colGt simpArg),+)? : tactic

elab_rules : tactic
| `(tactic| mono $[*]? $[$h:mono.side]? $[ with%$w $a:term,*]? $[ using%$u $s,*]? ) => do
  let msg (s : String) := s ++ " syntax is not yet supported in 'mono'"
  if let some h := h then throwErrorAt h (msg "'left'/'right'/'both'")
  if let some w := w then throwErrorAt w (msg "'with'")
  if let some u := u then throwErrorAt u (msg "'using'")
  let cfg ← elabApplyRulesConfig <| mkNullNode #[]
  let cfg := { cfg.noBackTracking with
    transparency := .reducible
    failAtMaxDepth := false
    exfalso := false }
  liftMetaTactic fun g => do solveByElim.processSyntax cfg false false [] [] #[mkIdent `mono] [g]


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Johan Commelin
-/
import category_theory.adjunction.basic
import category_theory.limits.creates

/-!
# Adjunctions and limits

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

A left adjoint preserves colimits (`category_theory.adjunction.left_adjoint_preserves_colimits`),
and a right adjoint preserves limits (`category_theory.adjunction.right_adjoint_preserves_limits`).

Equivalences create and reflect (co)limits.
(`category_theory.adjunction.is_equivalence_creates_limits`,
`category_theory.adjunction.is_equivalence_creates_colimits`,
`category_theory.adjunction.is_equivalence_reflects_limits`,
`category_theory.adjunction.is_equivalence_reflects_colimits`,)

In `category_theory.adjunction.cocones_iso` we show that
when `F ⊣ G`,
the functor associating to each `Y` the cocones over `K ⋙ F` with cone point `Y`
is naturally isomorphic to
the functor associating to each `Y` the cocones over `K` with cone point `G.obj Y`.
-/

open opposite

namespace category_theory.adjunction
open category_theory
open category_theory.functor
open category_theory.limits

universes v u v₁ v₂ v₀ u₁ u₂

section arbitrary_universe

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

variables {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G)
include adj

section preservation_colimits
variables {J : Type u} [category.{v} J] (K : J ⥤ C)

/--
The right adjoint of `cocones.functoriality K F : cocone K ⥤ cocone (K ⋙ F)`.

Auxiliary definition for `functoriality_is_left_adjoint`.
-/
def functoriality_right_adjoint : cocone (K ⋙ F) ⥤ cocone K :=
(cocones.functoriality _ G) ⋙
  (cocones.precompose (K.right_unitor.inv ≫ (whisker_left K adj.unit) ≫ (associator _ _ _).inv))

local attribute [reducible] functoriality_right_adjoint

/--
The unit for the adjunction for `cocones.functoriality K F : cocone K ⥤ cocone (K ⋙ F)`.

Auxiliary definition for `functoriality_is_left_adjoint`.
-/
@[simps] def functoriality_unit :
  𝟭 (cocone K) ⟶ cocones.functoriality _ F ⋙ functoriality_right_adjoint adj K :=
{ app := λ c, { hom := adj.unit.app c.X } }

/--
The counit for the adjunction for `cocones.functoriality K F : cocone K ⥤ cocone (K ⋙ F)`.

Auxiliary definition for `functoriality_is_left_adjoint`.
-/
@[simps] def functoriality_counit :
  functoriality_right_adjoint adj K ⋙ cocones.functoriality _ F ⟶ 𝟭 (cocone (K ⋙ F)) :=
{ app := λ c, { hom := adj.counit.app c.X } }

/-- The functor `cocones.functoriality K F : cocone K ⥤ cocone (K ⋙ F)` is a left adjoint. -/
def functoriality_is_left_adjoint :
  is_left_adjoint (cocones.functoriality K F) :=
{ right := functoriality_right_adjoint adj K,
  adj := mk_of_unit_counit
  { unit := functoriality_unit adj K,
    counit := functoriality_counit adj K } }

/--
A left adjoint preserves colimits.

See <https://stacks.math.columbia.edu/tag/0038>.
-/
def left_adjoint_preserves_colimits : preserves_colimits_of_size.{v u} F :=
{ preserves_colimits_of_shape := λ J 𝒥,
  { preserves_colimit := λ F,
    by exactI
    { preserves := λ c hc, is_colimit.iso_unique_cocone_morphism.inv
        (λ s, @equiv.unique _ _ (is_colimit.iso_unique_cocone_morphism.hom hc _)
          (((adj.functoriality_is_left_adjoint _).adj).hom_equiv _ _)) } } }.

omit adj

@[priority 100] -- see Note [lower instance priority]
instance is_equivalence_preserves_colimits (E : C ⥤ D) [is_equivalence E] :
  preserves_colimits_of_size.{v u} E :=
left_adjoint_preserves_colimits E.adjunction

@[priority 100] -- see Note [lower instance priority]
instance is_equivalence_reflects_colimits (E : D ⥤ C) [is_equivalence E] :
  reflects_colimits_of_size.{v u} E :=
{ reflects_colimits_of_shape := λ J 𝒥, by exactI
  { reflects_colimit := λ K,
    { reflects := λ c t,
      begin
        have l := (is_colimit_of_preserves E.inv t).map_cocone_equiv E.as_equivalence.unit_iso.symm,
        refine (((is_colimit.precompose_inv_equiv K.right_unitor _).symm) l).of_iso_colimit _,
        tidy,
      end } } }

@[priority 100] -- see Note [lower instance priority]
instance is_equivalence_creates_colimits (H : D ⥤ C) [is_equivalence H] :
  creates_colimits_of_size.{v u} H :=
{ creates_colimits_of_shape := λ J 𝒥, by exactI
  { creates_colimit := λ F,
    { lifts := λ c t,
      { lifted_cocone := H.map_cocone_inv c,
        valid_lift := H.map_cocone_map_cocone_inv c } } } }

-- verify the preserve_colimits instance works as expected:
example (E : C ⥤ D) [is_equivalence E]
  (c : cocone K) (h : is_colimit c) : is_colimit (E.map_cocone c) :=
preserves_colimit.preserves h

lemma has_colimit_comp_equivalence (E : C ⥤ D) [is_equivalence E] [has_colimit K] :
  has_colimit (K ⋙ E) :=
has_colimit.mk
{ cocone := E.map_cocone (colimit.cocone K),
  is_colimit := preserves_colimit.preserves (colimit.is_colimit K) }

lemma has_colimit_of_comp_equivalence (E : C ⥤ D) [is_equivalence E] [has_colimit (K ⋙ E)] :
  has_colimit K :=
@has_colimit_of_iso _ _ _ _ (K ⋙ E ⋙ inv E) K
(@has_colimit_comp_equivalence _ _ _ _ _ _ (K ⋙ E) (inv E) _ _)
((functor.right_unitor _).symm ≪≫ iso_whisker_left K (E.as_equivalence.unit_iso))

/-- Transport a `has_colimits_of_shape` instance across an equivalence. -/
lemma has_colimits_of_shape_of_equivalence (E : C ⥤ D) [is_equivalence E]
  [has_colimits_of_shape J D] : has_colimits_of_shape J C :=
⟨λ F, by exactI has_colimit_of_comp_equivalence F E⟩

/-- Transport a `has_colimits` instance across an equivalence. -/
lemma has_colimits_of_equivalence (E : C ⥤ D) [is_equivalence E] [has_colimits_of_size.{v u} D] :
  has_colimits_of_size.{v u} C :=
⟨λ J hJ, by { exactI has_colimits_of_shape_of_equivalence E }⟩

end preservation_colimits

section preservation_limits
variables {J : Type u} [category.{v} J] (K : J ⥤ D)

/--
The left adjoint of `cones.functoriality K G : cone K ⥤ cone (K ⋙ G)`.

Auxiliary definition for `functoriality_is_right_adjoint`.
-/
def functoriality_left_adjoint : cone (K ⋙ G) ⥤ cone K :=
(cones.functoriality _ F) ⋙ (cones.postcompose
    ((associator _ _ _).hom ≫ (whisker_left K adj.counit) ≫ K.right_unitor.hom))

local attribute [reducible] functoriality_left_adjoint

/--
The unit for the adjunction for`cones.functoriality K G : cone K ⥤ cone (K ⋙ G)`.

Auxiliary definition for `functoriality_is_right_adjoint`.
-/
@[simps] def functoriality_unit' :
  𝟭 (cone (K ⋙ G)) ⟶ functoriality_left_adjoint adj K ⋙ cones.functoriality _ G :=
{ app := λ c, { hom := adj.unit.app c.X, } }

/--
The counit for the adjunction for`cones.functoriality K G : cone K ⥤ cone (K ⋙ G)`.

Auxiliary definition for `functoriality_is_right_adjoint`.
-/
@[simps] def functoriality_counit' :
  cones.functoriality _ G ⋙ functoriality_left_adjoint adj K ⟶ 𝟭 (cone K) :=
{ app := λ c, { hom := adj.counit.app c.X, } }

/-- The functor `cones.functoriality K G : cone K ⥤ cone (K ⋙ G)` is a right adjoint. -/
def functoriality_is_right_adjoint :
  is_right_adjoint (cones.functoriality K G) :=
{ left := functoriality_left_adjoint adj K,
  adj := mk_of_unit_counit
  { unit := functoriality_unit' adj K,
    counit := functoriality_counit' adj K } }

/--
A right adjoint preserves limits.

See <https://stacks.math.columbia.edu/tag/0038>.
-/
def right_adjoint_preserves_limits : preserves_limits_of_size.{v u} G :=
{ preserves_limits_of_shape := λ J 𝒥,
  { preserves_limit := λ K,
    by exactI
    { preserves := λ c hc, is_limit.iso_unique_cone_morphism.inv
        (λ s, @equiv.unique _ _ (is_limit.iso_unique_cone_morphism.hom hc _)
          (((adj.functoriality_is_right_adjoint _).adj).hom_equiv _ _).symm) } } }.

omit adj

@[priority 100] -- see Note [lower instance priority]
instance is_equivalence_preserves_limits (E : D ⥤ C) [is_equivalence E] :
  preserves_limits_of_size.{v u} E :=
right_adjoint_preserves_limits E.inv.adjunction

@[priority 100] -- see Note [lower instance priority]
instance is_equivalence_reflects_limits (E : D ⥤ C) [is_equivalence E] :
  reflects_limits_of_size.{v u} E :=
{ reflects_limits_of_shape := λ J 𝒥, by exactI
  { reflects_limit := λ K,
    { reflects := λ c t,
      begin
        have := (is_limit_of_preserves E.inv t).map_cone_equiv E.as_equivalence.unit_iso.symm,
        refine (((is_limit.postcompose_hom_equiv K.left_unitor _).symm) this).of_iso_limit _,
        tidy,
      end } } }

@[priority 100] -- see Note [lower instance priority]
instance is_equivalence_creates_limits (H : D ⥤ C) [is_equivalence H] :
  creates_limits_of_size.{v u} H :=
{ creates_limits_of_shape := λ J 𝒥, by exactI
  { creates_limit := λ F,
    { lifts := λ c t,
      { lifted_cone := H.map_cone_inv c,
        valid_lift := H.map_cone_map_cone_inv c } } } }

-- verify the preserve_limits instance works as expected:
example (E : D ⥤ C) [is_equivalence E]
  (c : cone K) [h : is_limit c] : is_limit (E.map_cone c) :=
preserves_limit.preserves h

lemma has_limit_comp_equivalence (E : D ⥤ C) [is_equivalence E] [has_limit K] :
  has_limit (K ⋙ E) :=
has_limit.mk
{ cone := E.map_cone (limit.cone K),
  is_limit := preserves_limit.preserves (limit.is_limit K) }

lemma has_limit_of_comp_equivalence (E : D ⥤ C) [is_equivalence E] [has_limit (K ⋙ E)] :
  has_limit K :=
@has_limit_of_iso _ _ _ _ (K ⋙ E ⋙ inv E) K
(@has_limit_comp_equivalence _ _ _ _ _ _ (K ⋙ E) (inv E) _ _)
((iso_whisker_left K E.as_equivalence.unit_iso.symm) ≪≫ (functor.right_unitor _))

/-- Transport a `has_limits_of_shape` instance across an equivalence. -/
lemma has_limits_of_shape_of_equivalence (E : D ⥤ C) [is_equivalence E] [has_limits_of_shape J C] :
  has_limits_of_shape J D :=
⟨λ F, by exactI has_limit_of_comp_equivalence F E⟩

/-- Transport a `has_limits` instance across an equivalence. -/
lemma has_limits_of_equivalence (E : D ⥤ C) [is_equivalence E] [has_limits_of_size.{v u} C] :
  has_limits_of_size.{v u} D :=
⟨λ J hJ, by exactI has_limits_of_shape_of_equivalence E⟩

end preservation_limits

/-- auxiliary construction for `cocones_iso` -/
@[simps]
def cocones_iso_component_hom {J : Type u} [category.{v} J] {K : J ⥤ C}
  (Y : D) (t : ((cocones J D).obj (op (K ⋙ F))).obj Y) :
  (G ⋙ (cocones J C).obj (op K)).obj Y :=
{ app := λ j, (adj.hom_equiv (K.obj j) Y) (t.app j),
  naturality' := λ j j' f, by { erw [← adj.hom_equiv_naturality_left, t.naturality], dsimp, simp } }

/-- auxiliary construction for `cocones_iso` -/
@[simps]
def cocones_iso_component_inv {J : Type u} [category.{v} J] {K : J ⥤ C}
  (Y : D) (t : (G ⋙ (cocones J C).obj (op K)).obj Y) :
  ((cocones J D).obj (op (K ⋙ F))).obj Y :=
{ app := λ j, (adj.hom_equiv (K.obj j) Y).symm (t.app j),
  naturality' := λ j j' f,
  begin
    erw [← adj.hom_equiv_naturality_left_symm, ← adj.hom_equiv_naturality_right_symm, t.naturality],
    dsimp, simp
  end }

/-- auxiliary construction for `cones_iso` -/
@[simps]
def cones_iso_component_hom {J : Type u} [category.{v} J] {K : J ⥤ D}
  (X : Cᵒᵖ) (t : (functor.op F ⋙ (cones J D).obj K).obj X) :
  ((cones J C).obj (K ⋙ G)).obj X :=
{ app := λ j, (adj.hom_equiv (unop X) (K.obj j)) (t.app j),
  naturality' := λ j j' f,
  begin
    erw [← adj.hom_equiv_naturality_right, ← t.naturality, category.id_comp, category.id_comp],
    refl
  end }

/-- auxiliary construction for `cones_iso` -/
@[simps]
def cones_iso_component_inv {J : Type u} [category.{v} J] {K : J ⥤ D}
  (X : Cᵒᵖ) (t : ((cones J C).obj (K ⋙ G)).obj X) :
  (functor.op F ⋙ (cones J D).obj K).obj X :=
{ app := λ j, (adj.hom_equiv (unop X) (K.obj j)).symm (t.app j),
  naturality' := λ j j' f,
  begin
    erw [← adj.hom_equiv_naturality_right_symm, ← t.naturality, category.id_comp, category.id_comp]
  end }

end arbitrary_universe

variables {C : Type u₁} [category.{v₀} C] {D : Type u₂} [category.{v₀} D]
{F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G)

/--
When `F ⊣ G`,
the functor associating to each `Y` the cocones over `K ⋙ F` with cone point `Y`
is naturally isomorphic to
the functor associating to each `Y` the cocones over `K` with cone point `G.obj Y`.
-/
-- Note: this is natural in K, but we do not yet have the tools to formulate that.
def cocones_iso {J : Type u} [category.{v} J] {K : J ⥤ C} :
  (cocones J D).obj (op (K ⋙ F)) ≅ G ⋙ (cocones J C).obj (op K) :=
nat_iso.of_components (λ Y,
{ hom := cocones_iso_component_hom adj Y,
  inv := cocones_iso_component_inv adj Y, })
(by tidy)

-- Note: this is natural in K, but we do not yet have the tools to formulate that.
/--
When `F ⊣ G`,
the functor associating to each `X` the cones over `K` with cone point `F.op.obj X`
is naturally isomorphic to
the functor associating to each `X` the cones over `K ⋙ G` with cone point `X`.
-/
def cones_iso {J : Type u} [category.{v} J] {K : J ⥤ D} :
  F.op ⋙ (cones J D).obj K ≅ (cones J C).obj (K ⋙ G) :=
nat_iso.of_components (λ X,
{ hom := cones_iso_component_hom adj X,
  inv := cones_iso_component_inv adj X, } )
(by tidy)

end category_theory.adjunction


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

import algebra.homology.homological_complex
import for_mathlib.algebra.homology.homological_complex_biprod
import for_mathlib.algebra.homology.trunc_le

open category_theory
open category_theory.category

variables {C : Type*} [category C]

namespace category_theory

namespace limits

lemma is_zero.iff_of_biprod [preadditive C] (A B : C) [has_binary_biproduct A B] :
  is_zero (A ⊞ B) ↔ is_zero A ∧ is_zero B :=
begin
  simp only [is_zero.iff_id_eq_zero],
  split,
  { intro h,
    split,
    { suffices : 𝟙 A = biprod.inl ≫ (𝟙 (A ⊞ B)) ≫ biprod.fst,
      { rw [this, h, zero_comp, comp_zero], },
      rw [id_comp, biprod.inl_fst], },
    { suffices : 𝟙 B = biprod.inr ≫ (𝟙 (A ⊞ B)) ≫ biprod.snd,
      { rw [this, h, zero_comp, comp_zero], },
      rw [id_comp, biprod.inr_snd], }, },
  { intro h,
    ext,
    { simpa only [comp_id, biprod.inl_fst, comp_zero, zero_comp] using h.left, },
    { simp only [comp_id, biprod.inl_snd, comp_zero, zero_comp], },
    { simp only [comp_id, biprod.inr_fst, comp_zero, zero_comp], },
    { simpa only [comp_id, biprod.inr_snd, comp_zero, zero_comp] using h.right, } },
end

end limits

end category_theory

open category_theory.limits

namespace cochain_complex

def is_bounded_above [has_zero_morphisms C] (K : cochain_complex C ℤ) : Prop :=
∃ (r : ℤ), ∀ (i : ℤ) (hi : r < i), is_zero (K.X i)

namespace is_bounded_above

lemma of_biprod [preadditive C] (K L : cochain_complex C ℤ)
  (hK : K.is_bounded_above) (hL : L.is_bounded_above)
  [∀ i, has_binary_biproduct (K.X i) (L.X i)] :
  is_bounded_above (homological_complex.biprod K L) :=
begin
  cases hK with k hk,
  cases hL with l hl,
  use max k l,
  intros i hi,
  dsimp,
  rw is_zero.iff_of_biprod,
  split,
  { apply hk,
    exact lt_of_le_of_lt (le_max_left _ _) hi, },
  { apply hl,
    exact lt_of_le_of_lt (le_max_right _ _) hi, },
end

lemma of_is_strictly_le [abelian C] (K : cochain_complex C ℤ) (n : ℤ)
  [K.is_strictly_le n] : is_bounded_above K :=
⟨n, λ i hi, is_strictly_le.is_zero K n i hi⟩

end is_bounded_above

end cochain_complex


import tactic
import category.functor
import category.applicative

universes u v

namespace monad

@[simp]
lemma bind_pure_star {m} [monad m] [is_lawful_monad m] (x : m punit) :
  x >>= (λ (_x : punit), pure punit.star : punit → m punit) = x :=
by { transitivity,
     { apply congr_arg, ext z, cases z, refl },
     { simp } }

variables {α β γ : Type u}
variables {m : Type u → Type v} [monad m]

@[reducible]
def pipe (a : α → m β) (b : β → m γ) : α → m γ :=
λ x, a x >>= b

infixr ` >=> `:55 := pipe

@[functor_norm]
lemma map_bind_eq_bind_comp {α β γ} {m} [monad m] [is_lawful_monad m]
  (f : α → β) (cmd : m α) (g : β → m γ) :
  (f <$> cmd) >>= g = cmd >>= g ∘ f :=
by rw [← bind_pure_comp_eq_map,bind_assoc,(∘)]; simp

@[functor_norm]
lemma bind_map {α β γ} {m} [monad m] [is_lawful_monad m]
  (f : α → γ → β) (cmd : m α) (g : α → m γ) :
  cmd >>= (λ x, f x <$> g x) = do { x ← cmd, y ← g x, pure $ f x y }  :=
by congr; ext; rw [← bind_pure (g x),map_bind]; simp

@[functor_norm]
lemma bind_seq {α β γ : Type u} {m} [monad m] [is_lawful_monad m]
  (f : α → m (γ → β)) (cmd : m α) (g : α → m γ) :
  cmd >>= (λ x, f x <*> g x) = do { x ← cmd, h ← f x, y ← g x, pure $ h y }  :=
by congr; ext; simp [seq_eq_bind_map] with functor_norm

end monad

attribute [functor_norm] bind_assoc has_bind.and_then map_bind seq_left_eq seq_right_eq

namespace sum

variables {e : Type v} {α β : Type u}

protected def seq : Π (x : sum e (α → β)) (f : sum e α), sum e β
| (sum.inl e) _ := sum.inl e
| (sum.inr f) x := f <$> x

instance : applicative (sum e) :=
{ seq := @sum.seq e,
  pure := @sum.inr e }

instance : is_lawful_applicative (sum e) :=
by constructor; intros;
   casesm* _ ⊕ _; simp [(<*>),sum.seq,pure,(<$>)];
   refl

end sum


import tactic

universe variables u v

notation `ε` binder `, ` r:(scoped p, classical.epsilon p) := r

namespace classical

variables {α : Sort u}
variables {β : Sort v}
variables {p q : α → Prop}
variables Hpq : ∀ x, p x → q x
variables Hex : ∃ x, p x

include Hpq Hex

lemma some_spec'
: q (some Hex) :=
begin
  apply Hpq,
  apply some_spec
end

variable [nonempty α]

lemma epsilon_spec'
: q (epsilon p) :=
begin
  apply Hpq,
  apply epsilon_spec Hex,
end

end classical

open tactic interactive interactive.types lean.parser
open tactic.interactive (tauto)

meta def apply_some_spec (id : parse $ optional (tk "with" *> ident_)) : tactic unit :=
do t ← target,
   (l,_) ← solve_aux t (do
     e ← to_expr ``(@classical.some _ _ _),
     v ← mk_fresh_name,
     generalize e v,
     (expr.pi v bi t e) ← target,
     return (expr.lam v bi t e)),
   refine ``(@classical.some_spec' _ _ %%l _ _),
   `[simp only],
   interactive.intro id,
   `[intros h, apply h] <|>
      tauto (some ()) <|>
      smt_tactic.execute smt_tactic.eblast <|>
      return ()

meta def apply_epsilon_spec (ex : parse $ optional texpr)
  (id : parse $ optional (tk "with" *> ident_)) : tactic unit :=
focus1 $
do t ← target,
   (l,_) ← solve_aux t (do
     e ← to_expr ``(classical.epsilon _),
     v ← mk_fresh_name,
     generalize e v,
     (expr.pi v bi t e) ← target,
     return (expr.lam v bi t e)),
   refine ``(@classical.epsilon_spec' _ _ %%l _ _ _),
   `[simp only],
   interactive.intro id,
   try `[intros h, apply h],
   all_goals (solve_by_elim <|> ↑ex >>= tactic.refine <|>
              tauto (some ()) <|>
              smt_tactic.execute (smt_tactic.intros >> smt_tactic.eblast) <|>
              return ())

run_cmd add_interactive [`apply_some_spec,`apply_epsilon_spec]


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.shapes.pullbacks
import category_theory.limits.shapes.zero_morphisms
import category_theory.limits.constructions.binary_products

/-!
# Limits involving zero objects

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

Binary products and coproducts with a zero object always exist,
and pullbacks/pushouts over a zero object are products/coproducts.
-/

noncomputable theory

open category_theory

variables {C : Type*} [category C]

namespace category_theory.limits

variables [has_zero_object C] [has_zero_morphisms C]
open_locale zero_object

/-- The limit cone for the product with a zero object. -/
def binary_fan_zero_left (X : C) : binary_fan (0 : C) X :=
binary_fan.mk 0 (𝟙 X)

/-- The limit cone for the product with a zero object is limiting. -/
def binary_fan_zero_left_is_limit (X : C) : is_limit (binary_fan_zero_left X) :=
binary_fan.is_limit_mk (λ s, binary_fan.snd s) (by tidy) (by tidy) (by tidy)

instance has_binary_product_zero_left (X : C) : has_binary_product (0 : C) X :=
has_limit.mk ⟨_, binary_fan_zero_left_is_limit X⟩

/-- A zero object is a left unit for categorical product. -/
def zero_prod_iso (X : C) : (0 : C) ⨯ X ≅ X :=
limit.iso_limit_cone ⟨_, binary_fan_zero_left_is_limit X⟩

@[simp] lemma zero_prod_iso_hom (X : C) : (zero_prod_iso X).hom = prod.snd :=
rfl
@[simp] lemma zero_prod_iso_inv_snd (X : C) : (zero_prod_iso X).inv ≫ prod.snd = 𝟙 X :=
by { dsimp [zero_prod_iso, binary_fan_zero_left], simp, }

/-- The limit cone for the product with a zero object. -/
def binary_fan_zero_right (X : C) : binary_fan X (0 : C) :=
binary_fan.mk (𝟙 X) 0

/-- The limit cone for the product with a zero object is limiting. -/
def binary_fan_zero_right_is_limit (X : C) : is_limit (binary_fan_zero_right X) :=
binary_fan.is_limit_mk (λ s, binary_fan.fst s) (by tidy) (by tidy) (by tidy)

instance has_binary_product_zero_right (X : C) : has_binary_product X (0 : C) :=
has_limit.mk ⟨_, binary_fan_zero_right_is_limit X⟩

/-- A zero object is a right unit for categorical product. -/
def prod_zero_iso (X : C) : X ⨯ (0 : C) ≅ X :=
limit.iso_limit_cone ⟨_, binary_fan_zero_right_is_limit X⟩

@[simp] lemma prod_zero_iso_hom (X : C) : (prod_zero_iso X).hom = prod.fst :=
rfl
@[simp] lemma prod_zero_iso_iso_inv_snd (X : C) : (prod_zero_iso X).inv ≫ prod.fst = 𝟙 X :=
by { dsimp [prod_zero_iso, binary_fan_zero_right], simp, }

/-- The colimit cocone for the coproduct with a zero object. -/
def binary_cofan_zero_left (X : C) : binary_cofan (0 : C) X :=
binary_cofan.mk 0 (𝟙 X)

/-- The colimit cocone for the coproduct with a zero object is colimiting. -/
def binary_cofan_zero_left_is_colimit (X : C) : is_colimit (binary_cofan_zero_left X) :=
binary_cofan.is_colimit_mk (λ s, binary_cofan.inr s) (by tidy) (by tidy) (by tidy)

instance has_binary_coproduct_zero_left (X : C) : has_binary_coproduct (0 : C) X :=
has_colimit.mk ⟨_, binary_cofan_zero_left_is_colimit X⟩

/-- A zero object is a left unit for categorical coproduct. -/
def zero_coprod_iso (X : C) : (0 : C) ⨿ X ≅ X :=
colimit.iso_colimit_cocone ⟨_, binary_cofan_zero_left_is_colimit X⟩

@[simp] lemma inr_zero_coprod_iso_hom (X : C) : coprod.inr ≫ (zero_coprod_iso X).hom = 𝟙 X :=
by { dsimp [zero_coprod_iso, binary_cofan_zero_left], simp, }
@[simp] lemma zero_coprod_iso_inv (X : C) : (zero_coprod_iso X).inv = coprod.inr :=
rfl

/-- The colimit cocone for the coproduct with a zero object. -/
def binary_cofan_zero_right (X : C) : binary_cofan X (0 : C) :=
binary_cofan.mk (𝟙 X) 0

/-- The colimit cocone for the coproduct with a zero object is colimiting. -/
def binary_cofan_zero_right_is_colimit (X : C) : is_colimit (binary_cofan_zero_right X) :=
binary_cofan.is_colimit_mk (λ s, binary_cofan.inl s) (by tidy) (by tidy) (by tidy)

instance has_binary_coproduct_zero_right (X : C) : has_binary_coproduct X (0 : C) :=
has_colimit.mk ⟨_, binary_cofan_zero_right_is_colimit X⟩

/-- A zero object is a right unit for categorical coproduct. -/
def coprod_zero_iso (X : C) : X ⨿ (0 : C) ≅ X :=
colimit.iso_colimit_cocone ⟨_, binary_cofan_zero_right_is_colimit X⟩

@[simp] lemma inr_coprod_zeroiso_hom (X : C) : coprod.inl ≫ (coprod_zero_iso X).hom = 𝟙 X :=
by { dsimp [coprod_zero_iso, binary_cofan_zero_right], simp, }
@[simp] lemma coprod_zero_iso_inv (X : C) : (coprod_zero_iso X).inv = coprod.inl :=
rfl

instance has_pullback_over_zero
  (X Y : C) [has_binary_product X Y] : has_pullback (0 : X ⟶ 0) (0 : Y ⟶ 0) :=
has_limit.mk ⟨_, is_pullback_of_is_terminal_is_product _ _ _ _
  has_zero_object.zero_is_terminal (prod_is_prod X Y)⟩

/-- The pullback over the zeron object is the product. -/
def pullback_zero_zero_iso (X Y : C) [has_binary_product X Y] :
  pullback (0 : X ⟶ 0) (0 : Y ⟶ 0) ≅ X ⨯ Y :=
limit.iso_limit_cone ⟨_, is_pullback_of_is_terminal_is_product _ _ _ _
  has_zero_object.zero_is_terminal (prod_is_prod X Y)⟩

@[simp] lemma pullback_zero_zero_iso_inv_fst (X Y : C) [has_binary_product X Y] :
  (pullback_zero_zero_iso X Y).inv ≫ pullback.fst = prod.fst :=
by { dsimp [pullback_zero_zero_iso], simp, }
@[simp] lemma pullback_zero_zero_iso_inv_snd (X Y : C) [has_binary_product X Y] :
  (pullback_zero_zero_iso X Y).inv ≫ pullback.snd = prod.snd :=
by { dsimp [pullback_zero_zero_iso], simp, }
@[simp] lemma pullback_zero_zero_iso_hom_fst (X Y : C) [has_binary_product X Y] :
  (pullback_zero_zero_iso X Y).hom ≫ prod.fst = pullback.fst :=
by { simp [←iso.eq_inv_comp], }
@[simp] lemma pullback_zero_zero_iso_hom_snd (X Y : C) [has_binary_product X Y] :
  (pullback_zero_zero_iso X Y).hom ≫ prod.snd = pullback.snd :=
by { simp [←iso.eq_inv_comp], }

instance has_pushout_over_zero
  (X Y : C) [has_binary_coproduct X Y] : has_pushout (0 : 0 ⟶ X) (0 : 0 ⟶ Y) :=
has_colimit.mk ⟨_, is_pushout_of_is_initial_is_coproduct _ _ _ _
  has_zero_object.zero_is_initial (coprod_is_coprod X Y)⟩

/-- The pushout over the zero object is the coproduct. -/
def pushout_zero_zero_iso
  (X Y : C) [has_binary_coproduct X Y] : pushout (0 : 0 ⟶ X) (0 : 0 ⟶ Y) ≅ X ⨿ Y :=
colimit.iso_colimit_cocone ⟨_, is_pushout_of_is_initial_is_coproduct _ _ _ _
  has_zero_object.zero_is_initial (coprod_is_coprod X Y)⟩

@[simp] lemma inl_pushout_zero_zero_iso_hom (X Y : C) [has_binary_coproduct X Y] :
  pushout.inl ≫ (pushout_zero_zero_iso X Y).hom = coprod.inl :=
by { dsimp [pushout_zero_zero_iso], simp, }
@[simp] lemma inr_pushout_zero_zero_iso_hom (X Y : C) [has_binary_coproduct X Y] :
  pushout.inr ≫ (pushout_zero_zero_iso X Y).hom = coprod.inr :=
by { dsimp [pushout_zero_zero_iso], simp, }
@[simp] lemma inl_pushout_zero_zero_iso_inv (X Y : C) [has_binary_coproduct X Y] :
  coprod.inl ≫ (pushout_zero_zero_iso X Y).inv = pushout.inl :=
by { simp [iso.comp_inv_eq], }
@[simp] lemma inr_pushout_zero_zero_iso_inv (X Y : C) [has_binary_coproduct X Y] :
  coprod.inr ≫ (pushout_zero_zero_iso X Y).inv = pushout.inr :=
by { simp [iso.comp_inv_eq], }

end category_theory.limits