/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import algebra.big_operators.order
import algebra.big_operators.ring
import algebra.char_zero.lemmas
import data.rat.cast

/-!
# The Oxford Invariants Puzzle Challenges - Summer 2021, Week 3, Problem 1

## Original statement

Let `n ≥ 3`, `a₁, ..., aₙ` be strictly positive integers such that `aᵢ ∣ aᵢ₋₁ + aᵢ₊₁` for
`i = 2, ..., n - 1`. Show that $\sum_{i=1}^{n-1}\dfrac{a_0a_n}{a_ia_{i+1}} ∈ \mathbb N$.

## Comments

Mathlib is based on type theory, so saying that a rational is a natural doesn't make sense. Instead,
we ask that there exists `b : ℕ` whose cast to `α` is the sum we want.

In mathlib, `ℕ` starts at `0`. To make the indexing cleaner, we use `a₀, ..., aₙ₋₁` instead of
`a₁, ..., aₙ`. Similarly, it's nicer to not use subtraction of naturals, so we replace
`aᵢ ∣ aᵢ₋₁ + aᵢ₊₁` by `aᵢ₊₁ ∣ aᵢ + aᵢ₊₂`.

We don't actually have to work in `ℚ` or `ℝ`. We can be even more general by stating the result for
any linearly ordered field.

Instead of having `n` naturals, we use a function `a : ℕ → ℕ`.

In the proof itself, we replace `n : ℕ, 1 ≤ n` by `n + 1`.

The statement is actually true for `n = 0, 1` (`n = 1, 2` before the reindexing) as the sum is
simply `0` and `1` respectively. So the version we prove is slightly more general.

Overall, the indexing is a bit of a mess to understand. But, trust Lean, it works.

## Formalised statement

Let `n : ℕ`, `a : ℕ → ℕ`, `∀ i ≤ n, 0 < a i`, `∀ i, i + 2 ≤ n → aᵢ₊₁ ∣ aᵢ + aᵢ₊₂` (read `→` as
"implies"). Then there exists `b : ℕ` such that `b` as an element of any linearly ordered field
equals $\sum_{i=0}^{n-1} (a_0 a_n) / (a_i a_{i+1})$.

## Proof outline

The case `n = 0` is trivial.

For `n + 1`, we prove the result by induction but by adding `aₙ₊₁ ∣ aₙ * b - a₀` to the induction
hypothesis, where `b` is the previous sum, $\sum_{i=0}^{n-1} (a_0 a_n) / (a_i a_{i+1})$, as a
natural.
* Base case:
  * $\sum_{i=0}^0 (a_0 a_{0+1}) / (a_0 a_{0+1})$ is a natural:
    $\sum_{i=0}^0 (a_0 a_{0+1}) / (a_0 a_{0+1}) = (a_0 a_1) / (a_0 a_1) = 1$.
  * Divisibility condition:
    `a₀ * 1 - a₀ = 0` is clearly divisible by `a₁`.
* Induction step:
  * $\sum_{i=0}^n (a_0 a_{n+1}) / (a_i a_{i+1})$ is a natural:
    $$\sum_{i=0}^{n+1} (a_0 a_{n+2}) / (a_i a_{i+1})
      = \sum_{i=0}^n\ (a_0 a_{n+2}) / (a_i a_{i+1}) + (a_0 a_{n+2}) / (a_{n+1} a_{n+2})
      = a_{n+2} / a_{n+1} × \sum_{i=0}^n (a_0 a_{n+1}) / (a_i a_{i+1}) + a_0 / a_{n+1}
      = a_{n+2} / a_{n+1} × b + a_0 / a_{n+1}
      = (a_n + a_{n+2}) / a_{n+1} × b - (a_n b - a_0)(a_{n+1})$$
    which is a natural because `(aₙ + aₙ₊₂)/aₙ₊₁`, `b` and `(aₙ * b - a₀)/aₙ₊₁` are (plus an
    annoying inequality, or the fact that the original sum is positive because its terms are).
  * Divisibility condition:
    `aₙ₊₁ * ((aₙ + aₙ₊₂)/aₙ₊₁ * b - (aₙ * b - a₀)/aₙ₊₁) - a₀ = aₙ₊₁aₙ₊₂b` is divisible by `aₙ₊₂`.
-/

open_locale big_operators

variables {α : Type*} [linear_ordered_field α]

theorem week3_p1 (n : ℕ) (a : ℕ → ℕ) (a_pos : ∀ i ≤ n, 0 < a i)
  (ha : ∀ i, i + 2 ≤ n → a (i + 1) ∣ a i + a (i + 2)) :
  ∃ b : ℕ, (b : α) = ∑ i in finset.range n, (a 0 * a n)/(a i * a (i + 1)) :=
begin
  -- Treat separately `n = 0` and `n ≥ 1`
  cases n,
  /- Case `n = 0`
  The sum is trivially equal to `0` -/
  { exact ⟨0, by rw [nat.cast_zero, finset.sum_range_zero]⟩ }, -- `⟨Claim it, Prove it⟩`
  /- Case `n ≥ 1`. We replace `n` by `n + 1` everywhere to make this inequality explicit
  Set up the stronger induction hypothesis -/
  rsuffices ⟨b, hb, -⟩ :
    ∃ b : ℕ, (b : α) = ∑ i in finset.range (n + 1), (a 0 * a (n + 1)) / (a i * a (i + 1))
    ∧ a (n + 1) ∣ a n * b - a 0,
  { exact ⟨b, hb⟩ },
  simp_rw ←@nat.cast_pos α at a_pos,
  /- Declare the induction
  `ih` will be the induction hypothesis -/
  induction n with n ih,
  /- Base case
  Claim that the sum equals `1`-/
  { refine ⟨1, _, _⟩,
    -- Check that this indeed equals the sum
    { rw [nat.cast_one, finset.sum_range_one, div_self],
      exact (mul_pos (a_pos 0 (nat.zero_le _)) (a_pos 1 (nat.zero_lt_succ _))).ne' },
    -- Check the divisibility condition
    { rw [mul_one, tsub_self],
      exact dvd_zero _ } },
  /- Induction step
  `b` is the value of the previous sum as a natural, `hb` is the proof that it is indeed the value,
  and `han` is the divisibility condition -/
  obtain ⟨b, hb, han⟩ := ih (λ i hi, ha i $ nat.le_succ_of_le hi)
    (λ i hi, a_pos i $ nat.le_succ_of_le hi),
  specialize ha n le_rfl,
  have ha₀ : a 0 ≤ a n * b, -- Needing this is an artifact of `ℕ`-subtraction.
  { rw [←@nat.cast_le α, nat.cast_mul, hb, ←div_le_iff' (a_pos _ $ n.le_succ.trans $ nat.le_succ _),
      ←mul_div_mul_right _ _ (a_pos _ $ nat.le_succ _).ne'],
    suffices h : ∀ i, i ∈ finset.range (n + 1) → 0 ≤ (a 0 : α) * a (n + 1) / (a i * a (i + 1)),
    { exact finset.single_le_sum h (finset.self_mem_range_succ n) },
    refine (λ i _, div_nonneg _ _); refine mul_nonneg _ _; exact nat.cast_nonneg _ },
  -- Claim that the sum equals `(aₙ + aₙ₊₂)/aₙ₊₁ * b - (aₙ * b - a₀)/aₙ₊₁`
  refine ⟨(a n + a (n + 2))/ a (n + 1) * b - (a n * b - a 0) / a (n + 1), _, _⟩,
  -- Check that this indeed equals the sum
  { calc
      (((a n + a (n + 2)) / a (n + 1) * b - (a n * b - a 0) / a (n + 1) : ℕ) : α)
        = (a n + a (n + 2)) / a (n + 1) * b - (a n * b - a 0) / a (n + 1) : begin
          norm_cast,
          rw nat.cast_sub (nat.div_le_of_le_mul _),
          rw [←mul_assoc, nat.mul_div_cancel' ha, add_mul],
          exact tsub_le_self.trans (nat.le_add_right _ _),
        end
    ... = a (n + 2) / a (n + 1) * b + (a 0 * a (n + 2)) / (a (n + 1) * a (n + 2))
        : by rw [add_div, add_mul, sub_div, mul_div_right_comm, add_sub_sub_cancel,
            mul_div_mul_right _ _ (a_pos _ le_rfl).ne']
    ... = ∑ (i : ℕ) in finset.range (n + 2), a 0 * a (n + 2) / (a i * a (i + 1))
        : begin
          rw [finset.sum_range_succ, hb, finset.mul_sum],
          congr, ext i,
          rw [←mul_div_assoc, ←mul_div_right_comm, mul_div_assoc, mul_div_cancel _
            (a_pos _ $ nat.le_succ _).ne', mul_comm],
        end },
  -- Check the divisibility condition
  { rw [mul_tsub, ← mul_assoc, nat.mul_div_cancel' ha, add_mul,
      nat.mul_div_cancel' han, add_tsub_tsub_cancel ha₀, add_tsub_cancel_right],
    exact dvd_mul_right _ _ }
end


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import algebra.hom.equiv.basic
import data.part
import data.enat.lattice
import tactic.norm_num

/-!
# Natural numbers with infinity

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

The natural numbers and an extra `top` element `⊤`. This implementation uses `part ℕ` as an
implementation. Use `ℕ∞` instead unless you care about computability.

## Main definitions

The following instances are defined:

* `ordered_add_comm_monoid part_enat`
* `canonically_ordered_add_monoid part_enat`
* `complete_linear_order part_enat`

There is no additive analogue of `monoid_with_zero`; if there were then `part_enat` could
be an `add_monoid_with_top`.

* `to_with_top` : the map from `part_enat` to `ℕ∞`, with theorems that it plays well
with `+` and `≤`.

* `with_top_add_equiv : part_enat ≃+ ℕ∞`
* `with_top_order_iso : part_enat ≃o ℕ∞`

## Implementation details

`part_enat` is defined to be `part ℕ`.

`+` and `≤` are defined on `part_enat`, but there is an issue with `*` because it's not
clear what `0 * ⊤` should be. `mul` is hence left undefined. Similarly `⊤ - ⊤` is ambiguous
so there is no `-` defined on `part_enat`.

Before the `open_locale classical` line, various proofs are made with decidability assumptions.
This can cause issues -- see for example the non-simp lemma `to_with_top_zero` proved by `rfl`,
followed by `@[simp] lemma to_with_top_zero'` whose proof uses `convert`.

## Tags

part_enat, ℕ∞
-/
open part (hiding some)

/-- Type of natural numbers with infinity (`⊤`) -/
def part_enat : Type := part ℕ

namespace part_enat

/-- The computable embedding `ℕ → part_enat`.

This coincides with the coercion `coe : ℕ → part_enat`, see `part_enat.some_eq_coe`.
However, `coe` is noncomputable so `some` is preferable when computability is a concern. -/
def some : ℕ → part_enat := part.some

instance : has_zero part_enat := ⟨some 0⟩
instance : inhabited part_enat := ⟨0⟩
instance : has_one part_enat := ⟨some 1⟩
instance : has_add part_enat := ⟨λ x y, ⟨x.dom ∧ y.dom, λ h, get x h.1 + get y h.2⟩⟩

instance (n : ℕ) : decidable (some n).dom := is_true trivial

@[simp] lemma dom_some (x : ℕ) : (some x).dom := trivial

instance : add_comm_monoid part_enat :=
{ add       := (+),
  zero      := (0),
  add_comm  := λ x y, part.ext' and.comm (λ _ _, add_comm _ _),
  zero_add  := λ x, part.ext' (true_and _) (λ _ _, zero_add _),
  add_zero  := λ x, part.ext' (and_true _) (λ _ _, add_zero _),
  add_assoc := λ x y z, part.ext' and.assoc (λ _ _, add_assoc _ _ _) }

instance : add_comm_monoid_with_one part_enat :=
{ one := 1,
  nat_cast := some,
  nat_cast_zero := rfl,
  nat_cast_succ := λ _, part.ext' (true_and _).symm (λ _ _, rfl),
  .. part_enat.add_comm_monoid }

lemma some_eq_coe (n : ℕ) : some n = n := rfl

@[simp, norm_cast] lemma coe_inj {x y : ℕ} : (x : part_enat) = y ↔ x = y := part.some_inj

@[simp]

instance : can_lift part_enat ℕ coe dom := ⟨λ n hn, ⟨n.get hn, part.some_get _⟩⟩

instance : has_le part_enat := ⟨λ x y, ∃ h : y.dom → x.dom, ∀ hy : y.dom, x.get (h hy) ≤ y.get hy⟩
instance : has_top part_enat := ⟨none⟩
instance : has_bot part_enat := ⟨0⟩
instance : has_sup part_enat := ⟨λ x y, ⟨x.dom ∧ y.dom, λ h, x.get h.1 ⊔ y.get h.2⟩⟩

lemma le_def (x y : part_enat) :
  x ≤ y ↔ ∃ h : y.dom → x.dom, ∀ hy : y.dom, x.get (h hy) ≤ y.get hy :=
iff.rfl

@[elab_as_eliminator] protected lemma cases_on' {P : part_enat → Prop} :
  ∀ a : part_enat, P ⊤ → (∀ n : ℕ, P (some n)) → P a :=
part.induction_on

@[elab_as_eliminator] protected lemma cases_on {P : part_enat → Prop} :
  ∀ a : part_enat, P ⊤ → (∀ n : ℕ, P n) → P a :=
by { simp only [← some_eq_coe], exact part_enat.cases_on' }

@[simp] lemma top_add (x : part_enat) : ⊤ + x = ⊤ :=
part.ext' (false_and _) (λ h, h.left.elim)

@[simp] lemma add_top (x : part_enat) : x + ⊤ = ⊤ :=
by rw [add_comm, top_add]

@[simp] lemma coe_get {x : part_enat} (h : x.dom) : (x.get h : part_enat) = x :=
by { rw [← some_eq_coe], exact part.ext' (iff_of_true trivial h) (λ _ _, rfl) }

@[simp, norm_cast] lemma get_coe' (x : ℕ) (h : (x : part_enat).dom) : get (x : part_enat) h = x :=
by rw [← coe_inj, coe_get]

lemma get_coe {x : ℕ} : get (x : part_enat) (dom_coe x) = x := get_coe' _ _

lemma coe_add_get {x : ℕ} {y : part_enat} (h : ((x : part_enat) + y).dom) :
  get ((x : part_enat) + y) h = x + get y h.2 :=
by { simp only [← some_eq_coe] at h ⊢, refl }

@[simp] lemma get_add {x y : part_enat} (h : (x + y).dom) :
  get (x + y) h = x.get h.1 + y.get h.2 := rfl

@[simp] lemma get_zero (h : (0 : part_enat).dom) : (0 : part_enat).get h = 0 := rfl

@[simp] lemma get_one (h : (1 : part_enat).dom) : (1 : part_enat).get h = 1 := rfl

lemma get_eq_iff_eq_some {a : part_enat} {ha : a.dom} {b : ℕ} :
  a.get ha = b ↔ a = some b := get_eq_iff_eq_some

lemma get_eq_iff_eq_coe {a : part_enat} {ha : a.dom} {b : ℕ} :
  a.get ha = b ↔ a = b := by rw [get_eq_iff_eq_some, some_eq_coe]

lemma dom_of_le_of_dom {x y : part_enat} : x ≤ y → y.dom → x.dom := λ ⟨h, _⟩, h

lemma dom_of_le_some {x : part_enat} {y : ℕ} (h : x ≤ some y) : x.dom := dom_of_le_of_dom h trivial

lemma dom_of_le_coe {x : part_enat} {y : ℕ} (h : x ≤ y) : x.dom :=
by { rw [← some_eq_coe] at h, exact dom_of_le_some h }

instance decidable_le (x y : part_enat) [decidable x.dom] [decidable y.dom] : decidable (x ≤ y) :=
if hx : x.dom
then decidable_of_decidable_of_iff
  (show decidable (∀ (hy : (y : part_enat).dom), x.get hx ≤ (y : part_enat).get hy),
    from forall_prop_decidable _) $
  by { dsimp [(≤)], simp only [hx, exists_prop_of_true, forall_true_iff] }
else if hy : y.dom
then is_false $ λ h, hx $ dom_of_le_of_dom h hy
else is_true ⟨λ h, (hy h).elim, λ h, (hy h).elim⟩

/-- The coercion `ℕ → part_enat` preserves `0` and addition. -/
def coe_hom : ℕ →+ part_enat := ⟨coe, nat.cast_zero, nat.cast_add⟩

@[simp] lemma coe_coe_hom : ⇑coe_hom = coe := rfl

instance : partial_order part_enat :=
{ le          := (≤),
  le_refl     := λ x, ⟨id, λ _, le_rfl⟩,
  le_trans    := λ x y z ⟨hxy₁, hxy₂⟩ ⟨hyz₁, hyz₂⟩,
    ⟨hxy₁ ∘ hyz₁, λ _, le_trans (hxy₂ _) (hyz₂ _)⟩,
  le_antisymm := λ x y ⟨hxy₁, hxy₂⟩ ⟨hyx₁, hyx₂⟩, part.ext' ⟨hyx₁, hxy₁⟩
    (λ _ _, le_antisymm (hxy₂ _) (hyx₂ _)) }

lemma lt_def (x y : part_enat) : x < y ↔ ∃ (hx : x.dom), ∀ (hy : y.dom), x.get hx < y.get hy :=
begin
  rw [lt_iff_le_not_le, le_def, le_def, not_exists],
  split,
  { rintro ⟨⟨hyx, H⟩, h⟩,
    by_cases hx : x.dom,
    { use hx, intro hy,
      specialize H hy, specialize h (λ _, hy),
      rw not_forall at h, cases h with hx' h,
      rw not_le at h, exact h },
    { specialize h (λ hx', (hx hx').elim),
      rw not_forall at h, cases h with hx' h,
      exact (hx hx').elim } },
  { rintro ⟨hx, H⟩, exact ⟨⟨λ _, hx, λ hy, (H hy).le⟩, λ hxy h, not_lt_of_le (h _) (H _)⟩ }
end

@[simp, norm_cast] lemma coe_le_coe {x y : ℕ} : (x : part_enat) ≤ y ↔ x ≤ y :=
by { rw [← some_eq_coe, ← some_eq_coe], exact ⟨λ ⟨_, h⟩, h trivial, λ h, ⟨λ _, trivial, λ _, h⟩⟩ }

@[simp, norm_cast] lemma coe_lt_coe {x y : ℕ} : (x : part_enat) < y ↔ x < y :=
by rw [lt_iff_le_not_le, lt_iff_le_not_le, coe_le_coe, coe_le_coe]

@[simp] lemma get_le_get {x y : part_enat} {hx : x.dom} {hy : y.dom} :
  x.get hx ≤ y.get hy ↔ x ≤ y :=
by conv { to_lhs, rw [← coe_le_coe, coe_get, coe_get]}

lemma le_coe_iff (x : part_enat) (n : ℕ) : x ≤ n ↔ ∃ h : x.dom, x.get h ≤ n :=
begin
  rw [← some_eq_coe],
  show (∃ (h : true → x.dom), _) ↔ ∃ h : x.dom, x.get h ≤ n,
  simp only [forall_prop_of_true, some_eq_coe, dom_coe, get_coe']
end

lemma lt_coe_iff (x : part_enat) (n : ℕ) : x < n ↔ ∃ h : x.dom, x.get h < n :=
by simp only [lt_def, forall_prop_of_true, get_coe', dom_coe]

lemma coe_le_iff (n : ℕ) (x : part_enat) : (n : part_enat) ≤ x ↔ ∀ h : x.dom, n ≤ x.get h :=
begin
  rw [← some_eq_coe],
  simp only [le_def, exists_prop_of_true, dom_some, forall_true_iff],
  refl,
end

lemma coe_lt_iff (n : ℕ) (x : part_enat) : (n : part_enat) < x ↔ ∀ h : x.dom, n < x.get h :=
begin
  rw [← some_eq_coe],
  simp only [lt_def, exists_prop_of_true, dom_some, forall_true_iff],
  refl,
end

instance ne_zero.one : ne_zero (1 : part_enat) := ⟨coe_inj.not.mpr dec_trivial⟩

instance semilattice_sup : semilattice_sup part_enat :=
{ sup := (⊔),
  le_sup_left := λ _ _, ⟨and.left, λ _, le_sup_left⟩,
  le_sup_right := λ _ _, ⟨and.right, λ _, le_sup_right⟩,
  sup_le := λ x y z ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩, ⟨λ hz, ⟨hx₁ hz, hy₁ hz⟩,
    λ _, sup_le (hx₂ _) (hy₂ _)⟩,
  ..part_enat.partial_order }

instance order_bot : order_bot part_enat :=
{ bot := (⊥),
  bot_le := λ _, ⟨λ _, trivial, λ _, nat.zero_le _⟩ }

instance order_top : order_top part_enat :=
{ top := (⊤),
  le_top := λ x, ⟨λ h, false.elim h, λ hy, false.elim hy⟩ }

lemma eq_zero_iff {x : part_enat} : x = 0 ↔ x ≤ 0 := eq_bot_iff
lemma ne_zero_iff {x : part_enat} : x ≠ 0 ↔ ⊥ < x := bot_lt_iff_ne_bot.symm

lemma dom_of_lt {x y : part_enat} : x < y → x.dom :=
part_enat.cases_on x not_top_lt $ λ _ _, dom_coe _

lemma top_eq_none : (⊤ : part_enat) = none := rfl

@[simp] lemma coe_lt_top (x : ℕ) : (x : part_enat) < ⊤ :=
ne.lt_top (λ h, absurd (congr_arg dom h) $ by simpa only [dom_coe] using true_ne_false)

@[simp] lemma coe_ne_top (x : ℕ) : (x : part_enat) ≠ ⊤ := ne_of_lt (coe_lt_top x)

lemma not_is_max_coe (x : ℕ) : ¬ is_max (x : part_enat) :=
not_is_max_of_lt (coe_lt_top x)

lemma ne_top_iff {x : part_enat} : x ≠ ⊤ ↔ ∃ (n : ℕ), x = n :=
by simpa only [← some_eq_coe] using part.ne_none_iff

lemma ne_top_iff_dom {x : part_enat} : x ≠ ⊤ ↔ x.dom :=
by classical; exact not_iff_comm.1 part.eq_none_iff'.symm

lemma not_dom_iff_eq_top {x : part_enat} : ¬ x.dom ↔ x = ⊤ :=
iff.not_left ne_top_iff_dom.symm

lemma ne_top_of_lt {x y : part_enat} (h : x < y) : x ≠ ⊤ :=
ne_of_lt $ lt_of_lt_of_le h le_top

lemma eq_top_iff_forall_lt (x : part_enat) : x = ⊤ ↔ ∀ n : ℕ, (n : part_enat) < x :=
begin
  split,
  { rintro rfl n, exact coe_lt_top _ },
  { contrapose!, rw ne_top_iff, rintro ⟨n, rfl⟩, exact ⟨n, irrefl _⟩ }
end

lemma eq_top_iff_forall_le (x : part_enat) : x = ⊤ ↔ ∀ n : ℕ, (n : part_enat) ≤ x :=
(eq_top_iff_forall_lt x).trans
⟨λ h n, (h n).le, λ h n, lt_of_lt_of_le (coe_lt_coe.mpr n.lt_succ_self) (h (n + 1))⟩

lemma pos_iff_one_le {x : part_enat} : 0 < x ↔ 1 ≤ x :=
part_enat.cases_on x (by simp only [iff_true, le_top, coe_lt_top, ← @nat.cast_zero part_enat]) $
  λ n, by { rw [← nat.cast_zero, ← nat.cast_one, part_enat.coe_lt_coe, part_enat.coe_le_coe], refl }

instance : is_total part_enat (≤) :=
{ total := λ x y, part_enat.cases_on x
    (or.inr le_top) (part_enat.cases_on y (λ _, or.inl le_top)
      (λ x y, (le_total x y).elim (or.inr ∘ coe_le_coe.2)
        (or.inl ∘ coe_le_coe.2))) }

noncomputable instance : linear_order part_enat :=
{ le_total := is_total.total,
  decidable_le := classical.dec_rel _,
  max := (⊔),
  max_def := @sup_eq_max_default _ _ (id _) _,
  ..part_enat.partial_order }

instance : bounded_order part_enat :=
{ ..part_enat.order_top,
  ..part_enat.order_bot }

noncomputable instance : lattice part_enat :=
{ inf := min,
  inf_le_left := min_le_left,
  inf_le_right := min_le_right,
  le_inf := λ _ _ _, le_min,
  ..part_enat.semilattice_sup }

instance : ordered_add_comm_monoid part_enat :=
{ add_le_add_left := λ a b ⟨h₁, h₂⟩ c,
    part_enat.cases_on c (by simp)
      (λ c, ⟨λ h, and.intro (dom_coe _) (h₁ h.2),
        λ h, by simpa only [coe_add_get] using add_le_add_left (h₂ _) c⟩),
  ..part_enat.linear_order,
  ..part_enat.add_comm_monoid }

instance : canonically_ordered_add_monoid part_enat :=
{ le_self_add := λ a b, part_enat.cases_on b (le_top.trans_eq (add_top _).symm) $
    λ b, part_enat.cases_on a (top_add _).ge $
      λ a, (coe_le_coe.2 le_self_add).trans_eq (nat.cast_add _ _),
  exists_add_of_le := λ a b, part_enat.cases_on b (λ _, ⟨⊤, (add_top _).symm⟩) $
    λ b, part_enat.cases_on a (λ h, ((coe_lt_top _).not_le h).elim) $ λ a h, ⟨(b - a : ℕ),
        by rw [←nat.cast_add, coe_inj, add_comm, tsub_add_cancel_of_le (coe_le_coe.1 h)]⟩,
  ..part_enat.semilattice_sup,
  ..part_enat.order_bot,
  ..part_enat.ordered_add_comm_monoid }

lemma eq_coe_sub_of_add_eq_coe {x y : part_enat} {n : ℕ} (h : x + y = n) :
  x = ↑(n - y.get (dom_of_le_coe ((le_add_left le_rfl).trans_eq h))) :=
begin
  lift x to ℕ using dom_of_le_coe ((le_add_right le_rfl).trans_eq h),
  lift y to ℕ using dom_of_le_coe ((le_add_left le_rfl).trans_eq h),
  rw [← nat.cast_add, coe_inj] at h,
  rw [get_coe, coe_inj, eq_tsub_of_add_eq h]
end

protected lemma add_lt_add_right {x y z : part_enat} (h : x < y) (hz : z ≠ ⊤) : x + z < y + z :=
begin
  rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩,
  rcases ne_top_iff.mp hz with ⟨k, rfl⟩,
  induction y using part_enat.cases_on with n,
  { rw [top_add], apply_mod_cast coe_lt_top },
  norm_cast at h, apply_mod_cast add_lt_add_right h
end

protected lemma add_lt_add_iff_right {x y z : part_enat} (hz : z ≠ ⊤) : x + z < y + z ↔ x < y :=
⟨lt_of_add_lt_add_right, λ h, part_enat.add_lt_add_right h hz⟩

protected lemma add_lt_add_iff_left {x y z : part_enat} (hz : z ≠ ⊤) : z + x < z + y ↔ x < y :=
by rw [add_comm z, add_comm z, part_enat.add_lt_add_iff_right hz]

protected lemma lt_add_iff_pos_right {x y : part_enat} (hx : x ≠ ⊤) : x < x + y ↔ 0 < y :=
by { conv_rhs { rw [← part_enat.add_lt_add_iff_left hx] }, rw [add_zero] }

lemma lt_add_one {x : part_enat} (hx : x ≠ ⊤) : x < x + 1 :=
by { rw [part_enat.lt_add_iff_pos_right hx], norm_cast, norm_num }

lemma le_of_lt_add_one {x y : part_enat} (h : x < y + 1) : x ≤ y :=
begin
  induction y using part_enat.cases_on with n, apply le_top,
  rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩,
  apply_mod_cast nat.le_of_lt_succ, apply_mod_cast h
end

lemma add_one_le_of_lt {x y : part_enat} (h : x < y) : x + 1 ≤ y :=
begin
  induction y using part_enat.cases_on with n, apply le_top,
  rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩,
  apply_mod_cast nat.succ_le_of_lt, apply_mod_cast h
end

lemma add_one_le_iff_lt {x y : part_enat} (hx : x ≠ ⊤) : x + 1 ≤ y ↔ x < y :=
begin
  split, swap, exact add_one_le_of_lt,
  intro h, rcases ne_top_iff.mp hx with ⟨m, rfl⟩,
  induction y using part_enat.cases_on with n, apply coe_lt_top,
  apply_mod_cast nat.lt_of_succ_le, apply_mod_cast h
end

lemma lt_add_one_iff_lt {x y : part_enat} (hx : x ≠ ⊤) : x < y + 1 ↔ x ≤ y :=
begin
  split, exact le_of_lt_add_one,
  intro h, rcases ne_top_iff.mp hx with ⟨m, rfl⟩,
  induction y using part_enat.cases_on with n, { rw [top_add], apply coe_lt_top },
  apply_mod_cast nat.lt_succ_of_le, apply_mod_cast h
end

lemma add_eq_top_iff {a b : part_enat} : a + b = ⊤ ↔ a = ⊤ ∨ b = ⊤ :=
by apply part_enat.cases_on a; apply part_enat.cases_on b;
  simp; simp only [(nat.cast_add _ _).symm, part_enat.coe_ne_top]; simp

protected lemma add_right_cancel_iff {a b c : part_enat} (hc : c ≠ ⊤) : a + c = b + c ↔ a = b :=
begin
  rcases ne_top_iff.1 hc with ⟨c, rfl⟩,
  apply part_enat.cases_on a; apply part_enat.cases_on b;
  simp [add_eq_top_iff, coe_ne_top, @eq_comm _ (⊤ : part_enat)];
  simp only [(nat.cast_add _ _).symm, add_left_cancel_iff, part_enat.coe_inj, add_comm];
  tauto
end

protected lemma add_left_cancel_iff {a b c : part_enat} (ha : a ≠ ⊤) : a + b = a + c ↔ b = c :=
by rw [add_comm a, add_comm a, part_enat.add_right_cancel_iff ha]

section with_top

/-- Computably converts an `part_enat` to a `ℕ∞`. -/
def to_with_top (x : part_enat) [decidable x.dom] : ℕ∞ := x.to_option

lemma to_with_top_top : to_with_top ⊤ = ⊤ := rfl

@[simp] lemma to_with_top_top' {h : decidable (⊤ : part_enat).dom} : to_with_top ⊤ = ⊤ :=
by convert to_with_top_top

lemma to_with_top_zero : to_with_top 0 = 0 := rfl

@[simp] lemma to_with_top_zero' {h : decidable (0 : part_enat).dom} : to_with_top 0 = 0 :=
by convert to_with_top_zero

lemma to_with_top_some (n : ℕ) : to_with_top (some n) = n := rfl

lemma to_with_top_coe (n : ℕ) {_ : decidable (n : part_enat).dom} : to_with_top n = n :=
by simp only [← some_eq_coe, ← to_with_top_some]

@[simp] lemma to_with_top_coe' (n : ℕ) {h : decidable (n : part_enat).dom} :
  to_with_top (n : part_enat) = n :=
by convert to_with_top_coe n

@[simp] lemma to_with_top_le {x y : part_enat} : Π [decidable x.dom]
  [decidable y.dom], by exactI to_with_top x ≤ to_with_top y ↔ x ≤ y :=
part_enat.cases_on y (by simp) (part_enat.cases_on x (by simp) (by intros; simp))

@[simp] lemma to_with_top_lt {x y : part_enat} [decidable x.dom] [decidable y.dom] :
  to_with_top x < to_with_top y ↔ x < y :=
lt_iff_lt_of_le_iff_le to_with_top_le

end with_top

section with_top_equiv

open_locale classical

@[simp] lemma to_with_top_add {x y : part_enat} :
  to_with_top (x + y) = to_with_top x + to_with_top y :=
by apply part_enat.cases_on y; apply part_enat.cases_on x; simp [← nat.cast_add, ← enat.coe_add]

/-- `equiv` between `part_enat` and `ℕ∞` (for the order isomorphism see
`with_top_order_iso`). -/
noncomputable def with_top_equiv : part_enat ≃ ℕ∞ :=
{ to_fun := λ x, to_with_top x,
  inv_fun := λ x, match x with (option.some n) := coe n | none := ⊤ end,
  left_inv := λ x, by apply part_enat.cases_on x; intros; simp; refl,
  right_inv := λ x, by cases x; simp [with_top_equiv._match_1]; refl }

@[simp] lemma with_top_equiv_top : with_top_equiv ⊤ = ⊤ :=
to_with_top_top'

@[simp] lemma with_top_equiv_coe (n : nat) : with_top_equiv n = n :=
to_with_top_coe' _

@[simp] lemma with_top_equiv_zero : with_top_equiv 0 = 0 :=
by simpa only [nat.cast_zero] using with_top_equiv_coe 0

@[simp] lemma with_top_equiv_le {x y : part_enat} : with_top_equiv x ≤ with_top_equiv y ↔ x ≤ y :=
to_with_top_le

@[simp] lemma with_top_equiv_lt {x y : part_enat} : with_top_equiv x < with_top_equiv y ↔ x < y :=
to_with_top_lt

/-- `to_with_top` induces an order isomorphism between `part_enat` and `ℕ∞`. -/
noncomputable def with_top_order_iso : part_enat ≃o ℕ∞ :=
{ map_rel_iff' := λ _ _, with_top_equiv_le,
  .. with_top_equiv}

@[simp] lemma with_top_equiv_symm_top : with_top_equiv.symm ⊤ = ⊤ :=
rfl

@[simp] lemma with_top_equiv_symm_coe (n : nat) : with_top_equiv.symm n = n :=
rfl

@[simp] lemma with_top_equiv_symm_zero : with_top_equiv.symm 0 = 0 :=
rfl

@[simp] lemma with_top_equiv_symm_le {x y : ℕ∞} :
  with_top_equiv.symm x ≤ with_top_equiv.symm y ↔ x ≤ y :=
by rw ← with_top_equiv_le; simp

@[simp] lemma with_top_equiv_symm_lt {x y : ℕ∞} :
  with_top_equiv.symm x < with_top_equiv.symm y ↔ x < y :=
by rw ← with_top_equiv_lt; simp

/-- `to_with_top` induces an additive monoid isomorphism between `part_enat` and `ℕ∞`. -/
noncomputable def with_top_add_equiv : part_enat ≃+ ℕ∞ :=
{ map_add' := λ x y, by simp only [with_top_equiv]; convert to_with_top_add,
  ..with_top_equiv}

end with_top_equiv

lemma lt_wf : @well_founded part_enat (<) :=
begin
  classical,
  change well_founded (λ a b : part_enat, a < b),
  simp_rw ←to_with_top_lt,
  exact inv_image.wf _ (with_top.well_founded_lt nat.lt_wf)
end

instance : well_founded_lt part_enat := ⟨lt_wf⟩
instance : is_well_order part_enat (<) := { }
instance : has_well_founded part_enat := ⟨(<), lt_wf⟩

section find

variables (P : ℕ → Prop) [decidable_pred P]

/-- The smallest `part_enat` satisfying a (decidable) predicate `P : ℕ → Prop` -/
def find : part_enat := ⟨∃ n, P n, nat.find⟩

@[simp] lemma find_get (h : (find P).dom) : (find P).get h = nat.find h := rfl

lemma find_dom (h : ∃ n, P n) : (find P).dom := h

lemma lt_find (n : ℕ) (h : ∀ m ≤ n, ¬P m) : (n : part_enat) < find P :=
begin
  rw coe_lt_iff, intro h', rw find_get,
  have := @nat.find_spec P _ h',
  contrapose! this,
  exact h _ this
end

lemma lt_find_iff (n : ℕ) : (n : part_enat) < find P ↔ (∀ m ≤ n, ¬P m) :=
begin
  refine ⟨_, lt_find P n⟩,
  intros h m hm,
  by_cases H : (find P).dom,
  { apply nat.find_min H, rw coe_lt_iff at h, specialize h H, exact lt_of_le_of_lt hm h },
  { exact not_exists.mp H m }
end

lemma find_le (n : ℕ) (h : P n) : find P ≤ n :=
by { rw le_coe_iff, refine ⟨⟨_, h⟩, @nat.find_min' P _ _ _ h⟩ }

lemma find_eq_top_iff : find P = ⊤ ↔ ∀ n, ¬P n :=
(eq_top_iff_forall_lt _).trans
⟨λ h n, (lt_find_iff P n).mp (h n) _ le_rfl, λ h n, lt_find P n $ λ _ _, h _⟩

end find

noncomputable instance : linear_ordered_add_comm_monoid_with_top part_enat :=
{ top_add' := top_add,
  .. part_enat.linear_order,
  .. part_enat.ordered_add_comm_monoid,
  .. part_enat.order_top }

noncomputable instance : complete_linear_order part_enat :=
{ inf := (⊓),
  sup := (⊔),
  top := ⊤,
  bot := ⊥,
  le := (≤),
  lt := (<),
  .. part_enat.lattice,
  .. with_top_order_iso.symm.to_galois_insertion.lift_complete_lattice,
  .. part_enat.linear_order, }

end part_enat


import regular_sequence
import reals

namespace regular_sequence

def add : regular_sequence → regular_sequence → regular_sequence :=
λ a b,
  { val := λ n, a (2*n) + b (2*n),
    property :=
    begin
      intros m n m_pos n_pos,
      have two_m_pos: 0 < 2 * m,
        { exact nat.succ_mul_pos 1 m_pos },
      have two_n_pos: 0 < 2 * n,
        { exact nat.succ_mul_pos 1 n_pos },
      cases a,
      cases b,
      specialize a_property two_m_pos two_n_pos,
      specialize b_property two_m_pos two_n_pos,

      calc |a_val (2 * m) + b_val (2 * m) - (a_val (2 * n) + b_val (2 * n))| =
      |(a_val (2 * m) - a_val (2 * n)) + ((b_val (2 * m) - b_val (2 * n)))| : by ring_nf
        ... ≤ |a_val (2 * m) - a_val (2 * n)| + |b_val (2 * m) - b_val (2 * n)| : abs_add _ _
        ... ≤ ((↑(2 * m))⁻¹ + (↑(2 * n))⁻¹) + ((↑(2 * m))⁻¹ + (↑(2 * n))⁻¹) : add_le_add a_property b_property
        ... = (↑m)⁻¹ + (↑n)⁻¹ : by { push_cast, rw mul_inv₀, simp, norm_num, ring_nf, simp, rw mul_inv₀, ring,},
    end
  }

def neg (a: regular_sequence): regular_sequence :=
  { val := (λ x, -(a x)),
    property := λ _ _ m_pos n_pos, let h := a.property m_pos n_pos
        in by rwa [←abs_neg, neg_sub_neg, neg_sub] }

instance : has_neg regular_sequence :=
  ⟨neg⟩

lemma neg_apply (a: regular_sequence) (n: ℕ): -a n = -(a n) := rfl

instance : has_sub regular_sequence :=
  ⟨λ a b, add a (neg b)⟩

@[simp] lemma sub_apply (a b: regular_sequence) (n: ℕ): (a - b) n = a (2*n) - b (2*n) := rfl

lemma subs' {a b : regular_sequence} {n : ℕ}: (a-b) n  =  a (2*n) - b (2*n)  := rfl

instance : has_add regular_sequence :=
  ⟨add⟩

@[simp] lemma add_apply' (a b: regular_sequence) (n: ℕ): (a + b).val n = a (2*n) + b (2*n) := rfl

@[simp] lemma add_apply (a b: regular_sequence) (n: ℕ): (a + b) n = a (2*n) + b (2*n) := rfl

lemma zero_add {a : regular_sequence} {n : ℕ}: (0 + a) n = a (2*n) :=
  begin
    simp,
    refl,
  end

lemma add_zero {a : regular_sequence} {n : ℕ}: (a + 0) n = a (2*n) :=
  begin
    simp,
    refl,
  end

theorem add_lim_zero {f g : regular_sequence}
  (hf : lim_zero f) (hg : lim_zero g) : lim_zero (f + g) :=
  begin
    intros j hj,
    obtain ⟨N₁, hN₁⟩ := hf (2*j) (mul_pos zero_lt_two hj),
    obtain ⟨N₂, hN₂⟩ := hg (2*j) (mul_pos zero_lt_two hj),
    use max N₁ N₂,
    intros n hn,
    have h3 : | f (2*n) | + | g (2*n) | ≤ (2*j: ℚ)⁻¹+ (2*j: ℚ)⁻¹,
    {
      have hfg : | f (2*n) | ≤ (2*j: ℚ)⁻¹ ∧ | g (2*n) | ≤ (2*j: ℚ)⁻¹,
      {
        have : 2*n ≥ N₁ ∧ 2*n ≥ N₂,
        {
          have : n ≤ 2 * n,
          {
            obtain h := mul_le_mul one_le_two rfl.ge (zero_le n) (zero_le 2),
            rwa one_mul at h,
          },
          exact ⟨le_trans (le_of_max_le_left hn) this, le_trans (le_of_max_le_right hn) this⟩
        },
        obtain tt := hN₁ (2*n) this.1,
        obtain ttt := hN₂ (2*n) this.2,
        simp only [nat.cast_bit0, nat.cast_one, nat.cast_mul] at *,
        exact ⟨tt,ttt⟩,
      },
      exact add_le_add hfg.1 hfg.2,
    },
    rw [← one_mul (j : ℚ)⁻¹ ,← mul_inv_cancel (@two_ne_zero ℚ _ _), mul_assoc, ← @mul_inv₀ ℚ _ 2 (j : ℚ), two_mul],
    exact le_trans (abs_add (f (2 * n)) (g (2 * n))) h3,
  end

end regular_sequence

namespace real
open regular_sequence

def add: real → real → real :=
  quotient.lift₂ (λ x y, ⟦regular_sequence.add x y⟧)
  begin
    simp only [quotient.eq],
    intros a₁ b₁ a₂ b₂ a₁_eq_a₂ b₁_eq_b₂,
    rw equivalent_iff at *,
    unfold add,
    intros j j_pos,
    have two_j_pos : 0 < 2*j,
    {
      simpa,
    },
    specialize a₁_eq_a₂ (2*j) two_j_pos,
    specialize b₁_eq_b₂ (2*j) two_j_pos,
    obtain ⟨N, hN⟩ := a₁_eq_a₂,
    obtain ⟨M, hM⟩ := b₁_eq_b₂,
    use max N M,
    intros n n_ge_max,
    specialize hN (2*n),
    specialize hM (2*n),
    simp only [fn_apply, subtype.val_eq_coe],
    sorry,
  end

end real


import data.rat tactic.norm_num .misc .string

universes u v

variables {α : Type}

def N (α : Type) : Type := nat → α

def NN (α : Type) : Type := nat → nat → α

def N.eq (n : nat) (a b : N α) : Prop :=
∀ j < n, a j = b j

def NN.eq (m n : nat) (A B : NN α) : Prop :=
∀ i < m, ∀ j < n, A i j = B i j

def NN.mul_aux [ring α] (A B : NN α) (i j : nat) : nat → α
| 0       := 0
| (m + 1) := NN.mul_aux m + (A i m * B m j)

def NN.mul [ring α] (k m n : nat) (A B : NN α) : NN α | i j :=
NN.mul_aux A B i j m

lemma N.eq_zero (a b : N α) :
  N.eq 0 a b := forall_lt_zero _

lemma N.eq_succ {n : nat} {a b : N α} :
  a n = b n → N.eq n a b → N.eq n.succ a b :=
forall_lt_succ _ n

lemma NN.eq_zero {n : nat} {A B : NN α} :
  NN.eq 0 n A B := forall_lt_zero _

lemma NN.eq_succ {m n : nat} {A B : NN α} :
  N.eq n (A m) (B m) → NN.eq m n A B →
  NN.eq m.succ n A B := forall_lt_succ _ m

lemma NN.eq_symm {m n : nat} {A B : NN α} :
NN.eq m n A B → NN.eq m n B A :=
begin
  intros h1 i hi j hj,
  exact (h1 i hi j hj).symm
end

lemma NN.eq_trans {m n : nat} {A B C : NN α} :
NN.eq m n A B → NN.eq m n B C → NN.eq m n A C :=
begin
  intros h1 h2 i hi j hj,
  apply eq.trans (h1 i hi j hj) (h2 i hi j hj)
end

def N.of_list [inhabited α] : list α → nat →  α
| []      _     := inhabited.default α
| (a::as) 0     := a
| (a::as) (j+1) := N.of_list as j

def NN.of_lists (α : Type) [inhabited α] : list (list α) → NN α
| []      _     _ := inhabited.default α
| (l::ll) 0     j := N.of_list l j
| (l::ll) (i+1) j := NN.of_lists ll i j

instance N.eq.decidable [decidable_eq α] (n : nat) :
  decidable_rel (@N.eq α n) :=
by {intros A B, apply forall_lt.decidable}

instance NN.eq.decidable [decidable_eq α] (m n : nat) :
  decidable_rel (@NN.eq α m n) :=
by {intros A B, apply forall_lt.decidable}

/- repr -/

def N.cell_size [has_repr α] (b : N α) : nat → nat
| 0     := 0
| (n+1) := max (N.cell_size n) (repr $ b n).length

def NN.cell_size [has_repr α] (A : NN α) : nat → nat → nat
| 0     n := 0
| (m+1) n := max (NN.cell_size m n) (N.cell_size (A m) n)

def N.repr [has_repr α] (k : nat) (b : N α) : nat → string
| 0     := "|"
| (n+1) := N.repr n ++ " " ++ (repr $ b n).resize k ++ " |"

def NN.repr_aux [has_repr α] (k : nat) (A : NN α) : nat → nat → string
| 0     n := ""
| (m+1) n := NN.repr_aux m n ++ "\n" ++ N.repr k (A m) n

def NN.repr (m n : nat) [has_repr α] (A : NN α) : string :=
NN.repr_aux (NN.cell_size A m n) A m n

def N.le [has_le α] (k : nat) (v w : N α) : Prop :=
∀ x < k, v x ≤ w x

instance N.le.decidable [has_le α] [decidable_rel ((≤) : α → α → Prop)]
  (k : nat) (v w : N α) : decidable (N.le k v w) :=
forall_lt.decidable _ _

def N.zero (α : Type) [has_zero α] : N α := λ _, 0

def N.sum [has_zero α] [has_add α] : ∀ k : nat, ∀ v : N α, α
| 0       _ := 0
| (k + 1) v := v k + v.sum k

def dot_prod [has_zero α] [has_add α] [has_mul α] (k : nat) (v w : N α) : α :=
N.sum k (λ m, v m * w m)

def mul_vec [has_zero α] [has_add α] [has_mul α] (k : nat) (A : NN α) (x : N α) : N α :=
λ m, dot_prod k (A m) x

/- norm -/

open tactic expr

/- (N.mk_meta n) returns ⌜g : nat → α⌝, where ⌜f j⌝ is
   a unique metavariable for any j < n, and ⌜g j⌝ = x
   otherwise. -/
meta def N.mk_meta (τx tx : expr) : nat → tactic expr
| 0     := to_expr ``(λ x : nat, (%%tx : %%τx))
| (n+1) :=
  do gx ← N.mk_meta n,
     sx ← mk_meta_var τx,
     to_expr ``(update %%τx %%`(n) %%sx %%gx)

/- (mk_meta m n) returns ⌜f : NN α⌝, where each
   ⌜f i j⌝ is a unique metavariable for any
   i < m and j < n, and ⌜f i j⌝ = x otherwise. -/
meta def NN.mk_meta (αx ax : expr) : nat → nat → tactic expr
| 0     _ := to_expr ``(λ i j : nat, (%%ax : %%αx))
| (m+1) n :=
  do fx ← NN.mk_meta m n,
     gx ← N.mk_meta αx ax n,
     to_expr ``(update (N %%αx) %%`(m) %%gx %%fx)

meta def mul_simp_lemmas : list name :=
[`NN.mul, `NN.mul_aux, `N.of_list, `NN.of_lists]

meta def get_simp_lemmas : list name → tactic simp_lemmas
| []      := return simp_lemmas.mk
| (n::ns) :=
  do s ← get_simp_lemmas ns,
     s.add_simp n

meta def simp_mul (x : expr) : tactic (expr × expr) :=
do s ← get_simp_lemmas mul_simp_lemmas,
   simplify s [] x

/- Return ⌜h : t = s⌝ -/
meta def prove_eq (αx tx ux : expr) : tactic expr :=
do (sx,px) ← simp_mul tx,
   (rx,qx) ← norm_num.derive' sx,
   unify rx ux,
   to_expr ``(@eq.trans %%αx %%tx %%sx %%rx %%px %%qx)

/- Return ⌜h : N.eq n a b⌝ -/
meta def N.prove_eq (αx ax bx : expr) : nat → tactic expr
| 0     := return `(@N.eq_zero %%αx %%ax %%bx)
| (n+1) :=
  do px ← prove_eq αx (app ax `(n)) (app bx `(n)),
     qx ← N.prove_eq n,
     return `(@N.eq_succ %%αx %%`(n) %%ax %%bx %%px %%qx)

/- Return ⌜h : NN.eq m n A B⌝ -/
meta def NN.prove_eq (αx Ax Bx : expr) : nat → nat → tactic expr
| 0     n := return `(@NN.eq_zero %%αx %%`(n) %%Ax %%Bx)
| (m+1) n :=
  do px ← N.prove_eq αx (app Ax `(m)) (app Bx `(m)) n,
     qx ← NN.prove_eq m n,
     return `(@NN.eq_succ %%αx %%`(m) %%`(n) %%Ax %%Bx %%px %%qx)

/- Return ⌜B : NN α⌝ and ⌜h : NN.eq m n A B⌝ -/
meta def NN.norm (αx ax Ax : expr) (m n : nat) : tactic (expr × expr) :=
do Bx ← NN.mk_meta αx ax m n,
   px ← NN.prove_eq αx Ax Bx m n,
   return (Bx,px)

meta def NN.equate : tactic unit :=
do `(@NN.eq %%αx %%mx %%nx %%Ax %%Bx) ← target,
   ax ← get_default αx,
   m ← eval_expr nat mx,
   n ← eval_expr nat nx,
   (A'x, px) ← NN.norm αx ax Ax m n,
   (B'x, qx) ← NN.norm αx ax Bx m n,
   ( do is_def_eq A'x B'x,
        pq ← to_expr ``(@NN.eq_trans %%αx %%mx %%nx %%Ax %%A'x %%Bx
               %%px (@NN.eq_symm %%αx %%mx %%nx %%Bx %%B'x %%qx)),
        apply pq, skip ) <|>
   fail "Not definitionally equal"

/- Tests -/

set_option profiler true

lemma ex1 :
NN.eq 2 2
  ( NN.mul 2 2 2
    ( NN.of_lists int
      [ [ 9  , -7 ],
        [ 18 , 4  ] ] )
    ( NN.of_lists int
      [ [ -14 , 1 ],
        [ 5   , 22 ] ] ) )
  ( NN.of_lists int
    [ [ -161 , -145 ],
      [ -232 , 106  ] ] ) :=
by NN.equate

lemma ex2 :
NN.eq 3 2
  ( NN.mul 3 4 2
    ( NN.of_lists rat
      [ [ 4.5  , -3.5 , 12.5 , 0.5 ],
        [ -1/2 , -3/2 , -2   , 0   ],
        [ 20   , 2    , 3    , 1   ] ] )
    ( NN.of_lists rat
      [ [ 8    , 1/2   ],
        [ 5/2  , -13.5 ],
        [ 1/2  , 4     ],
        [ 21.5 , 11    ] ] ) )
  ( NN.of_lists rat
    [ [ 177/4 , 105 ],
      [ -35/4 , 12  ],
      [ 188   , 6   ] ] ) :=
by NN.equate

lemma ex3 :
NN.eq 3 3
  ( NN.mul 3 3 3
    ( NN.of_lists rat
      [ [ 1/3 , -3.2   , 0.9 ],
        [ -1/2 , 3 - 5 , -2  ],
        [ 20   , 2     , 3.4 ] ] )
    ( NN.of_lists rat
      [ [ 8   , 1/4 , 4/3   ],
        [ 5/3 , 3   , 4 * 7 ],
        [ 1/2 , 4   , 0     ] ] ) )
  ( NN.of_lists rat
    [ [ -133/60 , -71/12 , -4012/45 ],
      [ -25/3   , -113/8 , -170/3   ],
      [ 4951/30 , 123/5  , 248/3    ] ] ) :=
by NN.equate

lemma ex4 :
NN.eq 4 4
  ( NN.mul 4 4 4
    ( NN.of_lists int
      [ [ 9   , -71 , 25  , 1  ],
        [ -1  , -3  , -4  , 92 ],
        [ 133 , -39 , -23 , 0  ],
        [ 40  , 26  , 366 , 28 ] ] )
    ( NN.of_lists int
      [ [ 16  , 1   , 55  , -11 ],
        [ 512 , -27 , 219 , 129 ],
        [ 1   , 8   , -89 , 5   ],
        [ 43  , 22  , 4   , 42  ] ] ) )
  ( NN.of_lists int
    [ [ -36140 , 2148 , -17275 , -9091 ],
      [ 2400   , 2072 , 12     , 3468  ],
      [ -17863 , 1002 , 821    , -6609 ],
      [ 15522  , 2882 , -24568 , 5920  ] ] ) :=
by NN.equate

lemma ex5 :
NN.eq 5 5
  ( NN.mul 5 5 5
    ( NN.of_lists int
      [ [ 9   , -71 , 25  , 1   , 910 ],
        [ -1  , -3  , -4  , 92  , 52  ],
        [ 133 , -39 , -23 , 0   , -20 ],
        [ -12 , 492 , 9   , 10 , 1929 ],
        [ 40  , 26  , 366 , 28 , 2    ] ] )
    ( NN.of_lists int
      [ [ 16  , 1    , 55  , -11  , 13  ],
        [ 512 , -27  , 219 , 1921 , 212 ],
        [ 828   , 8  , -2  , 35   , 0   ],
        [ 1   , 4283 , -89 , 5    , 431 ],
        [ 43  , 22   , 4   , 42   , 880 ] ] ) )
  ( NN.of_lists int
    [ [ 23623  , 26429  , -11553 , -97390  , 786296  ],
      [ -2536  , 395228 , -8684  , -3248   , 84763   ],
      [ -37744 , 562    , -1260  , -78027  , -24139  ],
      [ 342121 , 72044  , 113896 , 1026647 , 1805978 ],
      [ 317114 , 122234 , 4678   , 62540   , 19860   ] ] ) :=
by NN.equate


import Lean

import Meta.Pull

open Lean Elab.Tactic Meta

theorem resolution_thm : ∀ {A B C : Prop}, (A ∨ B) → (¬ A ∨ C) → B ∨ C := by
  intros A B C h₁ h₂
  cases h₁ with
  | inl ap => cases h₂ with
              | inl nap => exact (False.elim (nap ap))
              | inr cp  => exact (Or.inr cp)
  | inr bp => exact (Or.inl bp)

theorem resolution_thm₂ : ∀ {A C: Prop}, A → (¬ A ∨ C) → C := λ a ornac =>
  match ornac with
  | Or.inl na => False.elim (na a)
  | Or.inr c  => c

theorem resolution_thm₃ : ∀ {A B: Prop}, (A ∨ B) → ¬ A → B := λ orab na =>
  match orab with
  | Or.inl a => False.elim (na a)
  | Or.inr b => b

theorem resolution_thm₄ : ∀ {A : Prop}, A → ¬ A → False := λ a na => na a

def resolutionCore (firstHyp secondHyp : Ident) (pivotTerm : Term) : TacticM Unit := do
  let fident1 ← mkIdent <$> mkFreshId
  let fident2 ← mkIdent <$> mkFreshId
  let notPivot : Term := Syntax.mkApp (mkIdent `Not) #[pivotTerm]
  let pivotExpr     ← elabTerm pivotTerm none
  let notPivotExpr  ← elabTerm notPivot none
  let firstHypType  ← inferType (← elabTerm firstHyp none)
  let secondHypType ← inferType (← elabTerm secondHyp none)

  let lenGoal ← getLength <$> getMainTarget
  pullCore pivotExpr    firstHypType  firstHyp  fident1
  pullCore notPivotExpr secondHypType secondHyp fident2

  let mut len₁ := getLength firstHypType
  if Option.isNone (getIndex pivotExpr firstHypType) then
    len₁ := len₁ - (getLength pivotExpr) + 1

  let len₂ := getLength secondHypType

  if lenGoal > 2 then
    for s in getCongAssoc (len₁ - 2) `orAssocConv do
      evalTactic (← `(tactic| apply $s))
      logInfo m!"....apply {s}"
      printGoal

  if len₁ > 1 then
    if len₂ > 1 then
      evalTactic (← `(tactic| exact resolution_thm $fident1 $fident2))
      logInfo m!"..close goal with resolution_thm"
    else
      evalTactic (← `(tactic| exact resolution_thm₃ $fident1 $fident2))
      logInfo m!"..close goal with resolution_thm₃"
  else
    if len₂ > 1 then
      evalTactic (← `(tactic| exact resolution_thm₂ $fident1 $fident2))
      logInfo m!"..close goal with resolution_thm₂"
    else
      evalTactic (← `(tactic| exact resolution_thm₄ $fident1 $fident2))
      logInfo m!"..close goal with resolution_thm₄"

syntax (name := resolution_1) "R1" ident "," ident "," term : tactic
@[tactic resolution_1] def evalResolution_1 : Tactic :=
  fun stx => withMainContext do
    let firstHyp : Ident := ⟨stx[1]⟩
    let secondHyp : Ident := ⟨stx[3]⟩
    let pivotTerm : Term := ⟨stx[5]⟩
    resolutionCore firstHyp secondHyp pivotTerm

syntax (name := resolution_2) "R2" ident "," ident "," term : tactic
@[tactic resolution_2] def evalResolution_2 : Tactic :=
  fun stx => withMainContext do
    let firstHyp : Ident := ⟨stx[1]⟩
    let secondHyp : Ident := ⟨stx[3]⟩
    let pivotTerm : Term := ⟨stx[5]⟩
    resolutionCore secondHyp firstHyp pivotTerm

example : A ∨ B ∨ D ∨ (W ∨ Z) → E ∨ F ∨ G ∨ ¬ (W ∨ Z) → A ∨ B ∨ D ∨ E ∨ F ∨ G := by
  intros h₁ h₂
  R1 h₁, h₂, (W ∨ Z)


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

universes u₁ v₁ l

namespace Mathlib

/-!
# The Yoneda embedding

The Yoneda embedding as a functor `yoneda : C ⥤ (Cᵒᵖ ⥤ Type v₁)`,
along with an instance that it is `fully_faithful`.

Also the Yoneda lemma, `yoneda_lemma : (yoneda_pairing C) ≅ (yoneda_evaluation C)`.

## References
* [Stacks: Opposite Categories and the Yoneda Lemma](https://stacks.math.columbia.edu/tag/001L)
-/

namespace category_theory

/--
The Yoneda embedding, as a functor from `C` into presheaves on `C`.

See https://stacks.math.columbia.edu/tag/001O.
-/
def yoneda {C : Type u₁} [category C] : C ⥤ Cᵒᵖ ⥤ Type v₁ :=
  functor.mk
    (fun (X : C) =>
      functor.mk (fun (Y : Cᵒᵖ) => opposite.unop Y ⟶ X)
        fun (Y Y' : Cᵒᵖ) (f : Y ⟶ Y') (g : opposite.unop Y ⟶ X) => has_hom.hom.unop f ≫ g)
    fun (X X' : C) (f : X ⟶ X') =>
      nat_trans.mk
        fun (Y : Cᵒᵖ)
          (g :
          functor.obj
            (functor.mk (fun (Y : Cᵒᵖ) => opposite.unop Y ⟶ X)
              fun (Y Y' : Cᵒᵖ) (f : Y ⟶ Y') (g : opposite.unop Y ⟶ X) => has_hom.hom.unop f ≫ g)
            Y) =>
          g ≫ f

/--
The co-Yoneda embedding, as a functor from `Cᵒᵖ` into co-presheaves on `C`.
-/
@[simp] theorem coyoneda_obj_map {C : Type u₁} [category C] (X : Cᵒᵖ) (Y : C) (Y' : C) (f : Y ⟶ Y') (g : opposite.unop X ⟶ Y) : functor.map (functor.obj coyoneda X) f g = g ≫ f :=
  Eq.refl (functor.map (functor.obj coyoneda X) f g)

namespace yoneda

theorem obj_map_id {C : Type u₁} [category C] {X : C} {Y : C} (f : opposite.op X ⟶ opposite.op Y) : functor.map (functor.obj yoneda X) f 𝟙 = nat_trans.app (functor.map yoneda (has_hom.hom.unop f)) (opposite.op Y) 𝟙 := sorry

@[simp] theorem naturality {C : Type u₁} [category C] {X : C} {Y : C} (α : functor.obj yoneda X ⟶ functor.obj yoneda Y) {Z : C} {Z' : C} (f : Z ⟶ Z') (h : Z' ⟶ X) : f ≫ nat_trans.app α (opposite.op Z') h = nat_trans.app α (opposite.op Z) (f ≫ h) :=
  Eq.symm (functor_to_types.naturality (functor.obj yoneda X) (functor.obj yoneda Y) α (has_hom.hom.op f) h)

/--
The Yoneda embedding is full.

See https://stacks.math.columbia.edu/tag/001P.
-/
protected instance yoneda_full {C : Type u₁} [category C] : full yoneda :=
  full.mk fun (X Y : C) (f : functor.obj yoneda X ⟶ functor.obj yoneda Y) => nat_trans.app f (opposite.op X) 𝟙

/--
The Yoneda embedding is faithful.

See https://stacks.math.columbia.edu/tag/001P.
-/
protected instance yoneda_faithful {C : Type u₁} [category C] : faithful yoneda :=
  faithful.mk

/-- Extensionality via Yoneda. The typical usage would be
```
-- Goal is `X ≅ Y`

-- Goal is `X ≅ Y`
apply yoneda.ext,
-- Goals are now functions `(Z ⟶ X) → (Z ⟶ Y)`, `(Z ⟶ Y) → (Z ⟶ X)`, and the fact that these

-- Goals are now functions `(Z ⟶ X) → (Z ⟶ Y)`, `(Z ⟶ Y) → (Z ⟶ X)`, and the fact that these
functions are inverses and natural in `Z`.
```
-/
def ext {C : Type u₁} [category C] (X : C) (Y : C) (p : {Z : C} → (Z ⟶ X) → (Z ⟶ Y)) (q : {Z : C} → (Z ⟶ Y) → (Z ⟶ X)) (h₁ : ∀ {Z : C} (f : Z ⟶ X), q (p f) = f) (h₂ : ∀ {Z : C} (f : Z ⟶ Y), p (q f) = f) (n : ∀ {Z Z' : C} (f : Z' ⟶ Z) (g : Z ⟶ X), p (f ≫ g) = f ≫ p g) : X ≅ Y :=
  preimage_iso (nat_iso.of_components (fun (Z : Cᵒᵖ) => iso.mk p q) sorry)

/--
If `yoneda.map f` is an isomorphism, so was `f`.
-/
def is_iso {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y) [is_iso (functor.map yoneda f)] : is_iso f :=
  is_iso_of_fully_faithful yoneda f

end yoneda

namespace coyoneda

@[simp] theorem naturality {C : Type u₁} [category C] {X : Cᵒᵖ} {Y : Cᵒᵖ} (α : functor.obj coyoneda X ⟶ functor.obj coyoneda Y) {Z : C} {Z' : C} (f : Z' ⟶ Z) (h : opposite.unop X ⟶ Z') : nat_trans.app α Z' h ≫ f = nat_trans.app α Z (h ≫ f) := sorry

protected instance coyoneda_full {C : Type u₁} [category C] : full coyoneda :=
  full.mk
    fun (X Y : Cᵒᵖ) (f : functor.obj coyoneda X ⟶ functor.obj coyoneda Y) =>
      has_hom.hom.op (nat_trans.app f (opposite.unop X) 𝟙)

protected instance coyoneda_faithful {C : Type u₁} [category C] : faithful coyoneda :=
  faithful.mk

/--
If `coyoneda.map f` is an isomorphism, so was `f`.
-/
def is_iso {C : Type u₁} [category C] {X : Cᵒᵖ} {Y : Cᵒᵖ} (f : X ⟶ Y) [is_iso (functor.map coyoneda f)] : is_iso f :=
  is_iso_of_fully_faithful coyoneda f

-- No need to use Cᵒᵖ here, works with any category

/-- A Type-valued presheaf `P` is isomorphic to the composition of `P` with the
  coyoneda functor coming from `punit`. -/
@[simp] theorem iso_comp_punit_inv_app {C : Type u₁} [category C] (P : C ⥤ Type v₁) (X : C) (a : functor.obj P X) (_x : opposite.unop (opposite.op PUnit)) : nat_trans.app (iso.inv (iso_comp_punit P)) X a _x = a :=
  Eq.refl (nat_trans.app (iso.inv (iso_comp_punit P)) X a _x)

end coyoneda

/--
A presheaf `F` is representable if there is object `X` so `F ≅ yoneda.obj X`.

See https://stacks.math.columbia.edu/tag/001Q.
-/
-- TODO should we make this a Prop, merely asserting existence of such an object?

class representable {C : Type u₁} [category C] (F : Cᵒᵖ ⥤ Type v₁)
where
  X : C
  w : functor.obj yoneda X ≅ F

end category_theory

namespace category_theory

-- For the rest of the file, we are using product categories,

-- so need to restrict to the case morphisms are in 'Type', not 'Sort'.

-- We need to help typeclass inference with some awkward universe levels here.

protected instance prod_category_instance_1 (C : Type u₁) [category C] : category ((Cᵒᵖ ⥤ Type v₁) × (Cᵒᵖ)) :=
  category_theory.prod (Cᵒᵖ ⥤ Type v₁) (Cᵒᵖ)

protected instance prod_category_instance_2 (C : Type u₁) [category C] : category (Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) :=
  category_theory.prod (Cᵒᵖ) (Cᵒᵖ ⥤ Type v₁)

/--
The "Yoneda evaluation" functor, which sends `X : Cᵒᵖ` and `F : Cᵒᵖ ⥤ Type`
to `F.obj X`, functorially in both `X` and `F`.
-/
def yoneda_evaluation (C : Type u₁) [category C] : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁) ⥤ Type (max u₁ v₁) :=
  evaluation_uncurried (Cᵒᵖ) (Type v₁) ⋙ ulift_functor

@[simp] theorem yoneda_evaluation_map_down (C : Type u₁) [category C] (P : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (Q : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (α : P ⟶ Q) (x : functor.obj (yoneda_evaluation C) P) : ulift.down (functor.map (yoneda_evaluation C) α x) =
  nat_trans.app (prod.snd α) (prod.fst Q) (functor.map (prod.snd P) (prod.fst α) (ulift.down x)) :=
  rfl

/--
The "Yoneda pairing" functor, which sends `X : Cᵒᵖ` and `F : Cᵒᵖ ⥤ Type`
to `yoneda.op.obj X ⟶ F`, functorially in both `X` and `F`.
-/
def yoneda_pairing (C : Type u₁) [category C] : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁) ⥤ Type (max u₁ v₁) :=
  functor.prod (functor.op yoneda) 𝟭 ⋙ functor.hom (Cᵒᵖ ⥤ Type v₁)

@[simp] theorem yoneda_pairing_map (C : Type u₁) [category C] (P : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (Q : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (α : P ⟶ Q) (β : functor.obj (yoneda_pairing C) P) : functor.map (yoneda_pairing C) α β = functor.map yoneda (has_hom.hom.unop (prod.fst α)) ≫ β ≫ prod.snd α :=
  rfl

/--
The Yoneda lemma asserts that that the Yoneda pairing
`(X : Cᵒᵖ, F : Cᵒᵖ ⥤ Type) ↦ (yoneda.obj (unop X) ⟶ F)`
is naturally isomorphic to the evaluation `(X, F) ↦ F.obj X`.

See https://stacks.math.columbia.edu/tag/001P.
-/
def yoneda_lemma (C : Type u₁) [category C] : yoneda_pairing C ≅ yoneda_evaluation C :=
  iso.mk
    (nat_trans.mk
      fun (F : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (x : functor.obj (yoneda_pairing C) F) => ulift.up (nat_trans.app x (prod.fst F) 𝟙))
    (nat_trans.mk
      fun (F : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (x : functor.obj (yoneda_evaluation C) F) =>
        nat_trans.mk
          fun (X : Cᵒᵖ)
            (a : functor.obj (opposite.unop (prod.fst (functor.obj (functor.prod (functor.op yoneda) 𝟭) F))) X) =>
            functor.map (prod.snd F) (has_hom.hom.op a) (ulift.down x))

/--
The isomorphism between `yoneda.obj X ⟶ F` and `F.obj (op X)`
(we need to insert a `ulift` to get the universes right!)
given by the Yoneda lemma.
-/
@[simp] def yoneda_sections {C : Type u₁} [category C] (X : C) (F : Cᵒᵖ ⥤ Type v₁) : (functor.obj yoneda X ⟶ F) ≅ ulift (functor.obj F (opposite.op X)) :=
  iso.app (yoneda_lemma C) (opposite.op X, F)

/--
We have a type-level equivalence between natural transformations from the yoneda embedding
and elements of `F.obj X`, without any universe switching.
-/
def yoneda_equiv {C : Type u₁} [category C] {X : C} {F : Cᵒᵖ ⥤ Type v₁} : (functor.obj yoneda X ⟶ F) ≃ functor.obj F (opposite.op X) :=
  equiv.trans (iso.to_equiv (yoneda_sections X F)) equiv.ulift

theorem yoneda_equiv_naturality {C : Type u₁} [category C] {X : C} {Y : C} {F : Cᵒᵖ ⥤ Type v₁} (f : functor.obj yoneda X ⟶ F) (g : Y ⟶ X) : functor.map F (has_hom.hom.op g) (coe_fn yoneda_equiv f) = coe_fn yoneda_equiv (functor.map yoneda g ≫ f) := sorry

@[simp] theorem yoneda_equiv_apply {C : Type u₁} [category C] {X : C} {F : Cᵒᵖ ⥤ Type v₁} (f : functor.obj yoneda X ⟶ F) : coe_fn yoneda_equiv f = nat_trans.app f (opposite.op X) 𝟙 :=
  rfl

@[simp] theorem yoneda_equiv_symm_app_apply {C : Type u₁} [category C] {X : C} {F : Cᵒᵖ ⥤ Type v₁} (x : functor.obj F (opposite.op X)) (Y : Cᵒᵖ) (f : opposite.unop Y ⟶ X) : nat_trans.app (coe_fn (equiv.symm yoneda_equiv) x) Y f = functor.map F (has_hom.hom.op f) x :=
  rfl

/--
When `C` is a small category, we can restate the isomorphism from `yoneda_sections`
without having to change universes.
-/
def yoneda_sections_small {C : Type u₁} [small_category C] (X : C) (F : Cᵒᵖ ⥤ Type u₁) : (functor.obj yoneda X ⟶ F) ≅ functor.obj F (opposite.op X) :=
  yoneda_sections X F ≪≫ ulift_trivial (functor.obj F (opposite.op X))

@[simp] theorem yoneda_sections_small_hom {C : Type u₁} [small_category C] (X : C) (F : Cᵒᵖ ⥤ Type u₁) (f : functor.obj yoneda X ⟶ F) : iso.hom (yoneda_sections_small X F) f = nat_trans.app f (opposite.op X) 𝟙 :=
  rfl

@[simp] theorem yoneda_sections_small_inv_app_apply {C : Type u₁} [small_category C] (X : C) (F : Cᵒᵖ ⥤ Type u₁) (t : functor.obj F (opposite.op X)) (Y : Cᵒᵖ) (f : opposite.unop Y ⟶ X) : nat_trans.app (iso.inv (yoneda_sections_small X F) t) Y f = functor.map F (has_hom.hom.op f) t :=
  rfl


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

! This file was ported from Lean 3 source module category_theory.subobject.lattice
! leanprover-community/mathlib commit 024a4231815538ac739f52d08dd20a55da0d6b23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Subobject.FactorThru
import Mathbin.CategoryTheory.Subobject.WellPowered

/-!
# The lattice of subobjects

We provide the `semilattice_inf` with `order_top (subobject X)` instance when `[has_pullback C]`,
and the `semilattice_sup (subobject X)` instance when `[has_images C] [has_binary_coproducts C]`.
-/

universe v₁ v₂ u₁ u₂

noncomputable section

open CategoryTheory CategoryTheory.Category CategoryTheory.Limits

variable {C : Type u₁} [Category.{v₁} C] {X Y Z : C}

variable {D : Type u₂} [Category.{v₂} D]

namespace CategoryTheory

namespace MonoOver

section Top

instance {X : C} : Top (MonoOver X) where top := mk' (𝟙 _)

instance {X : C} : Inhabited (MonoOver X) :=
  ⟨⊤⟩

/-- The morphism to the top object in `mono_over X`. -/
def leTop (f : MonoOver X) : f ⟶ ⊤ :=
  homMk f.arrow (comp_id _)
#align category_theory.mono_over.le_top CategoryTheory.MonoOver.leTop

@[simp]
theorem top_left (X : C) : ((⊤ : MonoOver X) : C) = X :=
  rfl
#align category_theory.mono_over.top_left CategoryTheory.MonoOver.top_left

@[simp]
theorem top_arrow (X : C) : (⊤ : MonoOver X).arrow = 𝟙 X :=
  rfl
#align category_theory.mono_over.top_arrow CategoryTheory.MonoOver.top_arrow

/-- `map f` sends `⊤ : mono_over X` to `⟨X, f⟩ : mono_over Y`. -/
def mapTop (f : X ⟶ Y) [Mono f] : (map f).obj ⊤ ≅ mk' f :=
  iso_of_both_ways (homMk (𝟙 _) rfl) (homMk (𝟙 _) (by simp [id_comp f]))
#align category_theory.mono_over.map_top CategoryTheory.MonoOver.mapTop

section

variable [HasPullbacks C]

/-- The pullback of the top object in `mono_over Y`
is (isomorphic to) the top object in `mono_over X`. -/
def pullbackTop (f : X ⟶ Y) : (pullback f).obj ⊤ ≅ ⊤ :=
  iso_of_both_ways (leTop _) (homMk (pullback.lift f (𝟙 _) (by tidy)) (pullback.lift_snd _ _ _))
#align category_theory.mono_over.pullback_top CategoryTheory.MonoOver.pullbackTop

/-- There is a morphism from `⊤ : mono_over A` to the pullback of a monomorphism along itself;
as the category is thin this is an isomorphism. -/
def topLePullbackSelf {A B : C} (f : A ⟶ B) [Mono f] :
    (⊤ : MonoOver A) ⟶ (pullback f).obj (mk' f) :=
  homMk _ (pullback.lift_snd _ _ rfl)
#align category_theory.mono_over.top_le_pullback_self CategoryTheory.MonoOver.topLePullbackSelf

/-- The pullback of a monomorphism along itself is isomorphic to the top object. -/
def pullbackSelf {A B : C} (f : A ⟶ B) [Mono f] : (pullback f).obj (mk' f) ≅ ⊤ :=
  iso_of_both_ways (leTop _) (topLePullbackSelf _)
#align category_theory.mono_over.pullback_self CategoryTheory.MonoOver.pullbackSelf

end

end Top

section Bot

variable [HasInitial C] [InitialMonoClass C]

instance {X : C} : Bot (MonoOver X) where bot := mk' (initial.to X)

@[simp]
theorem bot_left (X : C) : ((⊥ : MonoOver X) : C) = ⊥_ C :=
  rfl
#align category_theory.mono_over.bot_left CategoryTheory.MonoOver.bot_left

@[simp]
theorem bot_arrow {X : C} : (⊥ : MonoOver X).arrow = initial.to X :=
  rfl
#align category_theory.mono_over.bot_arrow CategoryTheory.MonoOver.bot_arrow

/-- The (unique) morphism from `⊥ : mono_over X` to any other `f : mono_over X`. -/
def botLe {X : C} (f : MonoOver X) : ⊥ ⟶ f :=
  homMk (initial.to _) (by simp)
#align category_theory.mono_over.bot_le CategoryTheory.MonoOver.botLe

/-- `map f` sends `⊥ : mono_over X` to `⊥ : mono_over Y`. -/
def mapBot (f : X ⟶ Y) [Mono f] : (map f).obj ⊥ ≅ ⊥ :=
  iso_of_both_ways (homMk (initial.to _) (by simp)) (homMk (𝟙 _) (by simp))
#align category_theory.mono_over.map_bot CategoryTheory.MonoOver.mapBot

end Bot

section ZeroOrderBot

variable [HasZeroObject C]

open ZeroObject

/-- The object underlying `⊥ : subobject B` is (up to isomorphism) the zero object. -/
def botCoeIsoZero {B : C} : ((⊥ : MonoOver B) : C) ≅ 0 :=
  initialIsInitial.uniqueUpToIso HasZeroObject.zeroIsInitial
#align category_theory.mono_over.bot_coe_iso_zero CategoryTheory.MonoOver.botCoeIsoZero

@[simp]
theorem bot_arrow_eq_zero [HasZeroMorphisms C] {B : C} : (⊥ : MonoOver B).arrow = 0 :=
  zero_of_source_iso_zero _ botCoeIsoZero
#align category_theory.mono_over.bot_arrow_eq_zero CategoryTheory.MonoOver.bot_arrow_eq_zero

end ZeroOrderBot

section Inf

variable [HasPullbacks C]

/-- When `[has_pullbacks C]`, `mono_over A` has "intersections", functorial in both arguments.

As `mono_over A` is only a preorder, this doesn't satisfy the axioms of `semilattice_inf`,
but we reuse all the names from `semilattice_inf` because they will be used to construct
`semilattice_inf (subobject A)` shortly.
-/
@[simps]
def inf {A : C} : MonoOver A ⥤ MonoOver A ⥤ MonoOver A
    where
  obj f := pullback f.arrow ⋙ map f.arrow
  map f₁ f₂ k :=
    {
      app := fun g => by
        apply hom_mk _ _
        apply pullback.lift pullback.fst (pullback.snd ≫ k.left) _
        rw [pullback.condition, assoc, w k]
        dsimp
        rw [pullback.lift_snd_assoc, assoc, w k] }
#align category_theory.mono_over.inf CategoryTheory.MonoOver.inf

/-- A morphism from the "infimum" of two objects in `mono_over A` to the first object. -/
def infLeLeft {A : C} (f g : MonoOver A) : (inf.obj f).obj g ⟶ f :=
  homMk _ rfl
#align category_theory.mono_over.inf_le_left CategoryTheory.MonoOver.infLeLeft

/-- A morphism from the "infimum" of two objects in `mono_over A` to the second object. -/
def infLeRight {A : C} (f g : MonoOver A) : (inf.obj f).obj g ⟶ g :=
  homMk _ pullback.condition
#align category_theory.mono_over.inf_le_right CategoryTheory.MonoOver.infLeRight

/-- A morphism version of the `le_inf` axiom. -/
def leInf {A : C} (f g h : MonoOver A) : (h ⟶ f) → (h ⟶ g) → (h ⟶ (inf.obj f).obj g) :=
  by
  intro k₁ k₂
  refine' hom_mk (pullback.lift k₂.left k₁.left _) _
  rw [w k₁, w k₂]
  erw [pullback.lift_snd_assoc, w k₁]
#align category_theory.mono_over.le_inf CategoryTheory.MonoOver.leInf

end Inf

section Sup

variable [HasImages C] [HasBinaryCoproducts C]

/-- When `[has_images C] [has_binary_coproducts C]`, `mono_over A` has a `sup` construction,
which is functorial in both arguments,
and which on `subobject A` will induce a `semilattice_sup`. -/
def sup {A : C} : MonoOver A ⥤ MonoOver A ⥤ MonoOver A :=
  curryObj ((forget A).Prod (forget A) ⋙ uncurry.obj Over.coprod ⋙ image)
#align category_theory.mono_over.sup CategoryTheory.MonoOver.sup

/-- A morphism version of `le_sup_left`. -/
def leSupLeft {A : C} (f g : MonoOver A) : f ⟶ (sup.obj f).obj g :=
  by
  refine' hom_mk (coprod.inl ≫ factor_thru_image _) _
  erw [category.assoc, image.fac, coprod.inl_desc]
  rfl
#align category_theory.mono_over.le_sup_left CategoryTheory.MonoOver.leSupLeft

/-- A morphism version of `le_sup_right`. -/
def leSupRight {A : C} (f g : MonoOver A) : g ⟶ (sup.obj f).obj g :=
  by
  refine' hom_mk (coprod.inr ≫ factor_thru_image _) _
  erw [category.assoc, image.fac, coprod.inr_desc]
  rfl
#align category_theory.mono_over.le_sup_right CategoryTheory.MonoOver.leSupRight

/-- A morphism version of `sup_le`. -/
def supLe {A : C} (f g h : MonoOver A) : (f ⟶ h) → (g ⟶ h) → ((sup.obj f).obj g ⟶ h) :=
  by
  intro k₁ k₂
  refine' hom_mk _ _
  apply image.lift ⟨_, h.arrow, coprod.desc k₁.left k₂.left, _⟩
  · dsimp
    ext1
    · simp [w k₁]
    · simp [w k₂]
  · apply image.lift_fac
#align category_theory.mono_over.sup_le CategoryTheory.MonoOver.supLe

end Sup

end MonoOver

namespace Subobject

section OrderTop

instance orderTop {X : C} : OrderTop (Subobject X)
    where
  top := Quotient.mk'' ⊤
  le_top := by
    refine' Quotient.ind' fun f => _
    exact ⟨mono_over.le_top f⟩
#align category_theory.subobject.order_top CategoryTheory.Subobject.orderTop

instance {X : C} : Inhabited (Subobject X) :=
  ⟨⊤⟩

theorem top_eq_id (B : C) : (⊤ : Subobject B) = Subobject.mk (𝟙 B) :=
  rfl
#align category_theory.subobject.top_eq_id CategoryTheory.Subobject.top_eq_id

theorem underlyingIso_top_hom {B : C} : (underlyingIso (𝟙 B)).Hom = (⊤ : Subobject B).arrow :=
  by
  convert underlying_iso_hom_comp_eq_mk (𝟙 B)
  simp only [comp_id]
#align category_theory.subobject.underlying_iso_top_hom CategoryTheory.Subobject.underlyingIso_top_hom

instance top_arrow_isIso {B : C} : IsIso (⊤ : Subobject B).arrow :=
  by
  rw [← underlying_iso_top_hom]
  infer_instance
#align category_theory.subobject.top_arrow_is_iso CategoryTheory.Subobject.top_arrow_isIso

@[simp, reassoc.1]
theorem underlyingIso_inv_top_arrow {B : C} :
    (underlyingIso _).inv ≫ (⊤ : Subobject B).arrow = 𝟙 B :=
  underlyingIso_arrow _
#align category_theory.subobject.underlying_iso_inv_top_arrow CategoryTheory.Subobject.underlyingIso_inv_top_arrow

@[simp]
theorem map_top (f : X ⟶ Y) [Mono f] : (map f).obj ⊤ = Subobject.mk f :=
  Quotient.sound' ⟨MonoOver.mapTop f⟩
#align category_theory.subobject.map_top CategoryTheory.Subobject.map_top

theorem top_factors {A B : C} (f : A ⟶ B) : (⊤ : Subobject B).Factors f :=
  ⟨f, comp_id _⟩
#align category_theory.subobject.top_factors CategoryTheory.Subobject.top_factors

theorem isIso_iff_mk_eq_top {X Y : C} (f : X ⟶ Y) [Mono f] : IsIso f ↔ mk f = ⊤ :=
  ⟨fun _ => mk_eq_mk_of_comm _ _ (as_iso f) (category.comp_id _), fun h =>
    by
    rw [← of_mk_le_mk_comp h.le, category.comp_id]
    exact is_iso.of_iso (iso_of_mk_eq_mk _ _ h)⟩
#align category_theory.subobject.is_iso_iff_mk_eq_top CategoryTheory.Subobject.isIso_iff_mk_eq_top

theorem isIso_arrow_iff_eq_top {Y : C} (P : Subobject Y) : IsIso P.arrow ↔ P = ⊤ := by
  rw [is_iso_iff_mk_eq_top, mk_arrow]
#align category_theory.subobject.is_iso_arrow_iff_eq_top CategoryTheory.Subobject.isIso_arrow_iff_eq_top

instance isIso_top_arrow {Y : C} : IsIso (⊤ : Subobject Y).arrow := by rw [is_iso_arrow_iff_eq_top]
#align category_theory.subobject.is_iso_top_arrow CategoryTheory.Subobject.isIso_top_arrow

theorem mk_eq_top_of_isIso {X Y : C} (f : X ⟶ Y) [IsIso f] : mk f = ⊤ :=
  (isIso_iff_mk_eq_top f).mp inferInstance
#align category_theory.subobject.mk_eq_top_of_is_iso CategoryTheory.Subobject.mk_eq_top_of_isIso

theorem eq_top_of_isIso_arrow {Y : C} (P : Subobject Y) [IsIso P.arrow] : P = ⊤ :=
  (isIso_arrow_iff_eq_top P).mp inferInstance
#align category_theory.subobject.eq_top_of_is_iso_arrow CategoryTheory.Subobject.eq_top_of_isIso_arrow

section

variable [HasPullbacks C]

theorem pullback_top (f : X ⟶ Y) : (pullback f).obj ⊤ = ⊤ :=
  Quotient.sound' ⟨MonoOver.pullbackTop f⟩
#align category_theory.subobject.pullback_top CategoryTheory.Subobject.pullback_top

theorem pullback_self {A B : C} (f : A ⟶ B) [Mono f] : (pullback f).obj (mk f) = ⊤ :=
  Quotient.sound' ⟨MonoOver.pullbackSelf f⟩
#align category_theory.subobject.pullback_self CategoryTheory.Subobject.pullback_self

end

end OrderTop

section OrderBot

variable [HasInitial C] [InitialMonoClass C]

instance orderBot {X : C} : OrderBot (Subobject X)
    where
  bot := Quotient.mk'' ⊥
  bot_le := by
    refine' Quotient.ind' fun f => _
    exact ⟨mono_over.bot_le f⟩
#align category_theory.subobject.order_bot CategoryTheory.Subobject.orderBot

theorem bot_eq_initial_to {B : C} : (⊥ : Subobject B) = Subobject.mk (initial.to B) :=
  rfl
#align category_theory.subobject.bot_eq_initial_to CategoryTheory.Subobject.bot_eq_initial_to

/-- The object underlying `⊥ : subobject B` is (up to isomorphism) the initial object. -/
def botCoeIsoInitial {B : C} : ((⊥ : Subobject B) : C) ≅ ⊥_ C :=
  underlyingIso _
#align category_theory.subobject.bot_coe_iso_initial CategoryTheory.Subobject.botCoeIsoInitial

theorem map_bot (f : X ⟶ Y) [Mono f] : (map f).obj ⊥ = ⊥ :=
  Quotient.sound' ⟨MonoOver.mapBot f⟩
#align category_theory.subobject.map_bot CategoryTheory.Subobject.map_bot

end OrderBot

section ZeroOrderBot

variable [HasZeroObject C]

open ZeroObject

/-- The object underlying `⊥ : subobject B` is (up to isomorphism) the zero object. -/
def botCoeIsoZero {B : C} : ((⊥ : Subobject B) : C) ≅ 0 :=
  botCoeIsoInitial ≪≫ initialIsInitial.uniqueUpToIso HasZeroObject.zeroIsInitial
#align category_theory.subobject.bot_coe_iso_zero CategoryTheory.Subobject.botCoeIsoZero

variable [HasZeroMorphisms C]

theorem bot_eq_zero {B : C} : (⊥ : Subobject B) = Subobject.mk (0 : 0 ⟶ B) :=
  mk_eq_mk_of_comm _ _ (initialIsInitial.uniqueUpToIso HasZeroObject.zeroIsInitial) (by simp)
#align category_theory.subobject.bot_eq_zero CategoryTheory.Subobject.bot_eq_zero

@[simp]
theorem bot_arrow {B : C} : (⊥ : Subobject B).arrow = 0 :=
  zero_of_source_iso_zero _ botCoeIsoZero
#align category_theory.subobject.bot_arrow CategoryTheory.Subobject.bot_arrow

theorem bot_factors_iff_zero {A B : C} (f : A ⟶ B) : (⊥ : Subobject B).Factors f ↔ f = 0 :=
  ⟨by
    rintro ⟨h, rfl⟩
    simp, by
    rintro rfl
    exact ⟨0, by simp⟩⟩
#align category_theory.subobject.bot_factors_iff_zero CategoryTheory.Subobject.bot_factors_iff_zero

theorem mk_eq_bot_iff_zero {f : X ⟶ Y} [Mono f] : Subobject.mk f = ⊥ ↔ f = 0 :=
  ⟨fun h => by simpa [h, bot_factors_iff_zero] using mk_factors_self f, fun h =>
    mk_eq_mk_of_comm _ _ ((isoZeroOfMonoEqZero h).trans HasZeroObject.zeroIsoInitial) (by simp [h])⟩
#align category_theory.subobject.mk_eq_bot_iff_zero CategoryTheory.Subobject.mk_eq_bot_iff_zero

end ZeroOrderBot

section Functor

variable (C)

/-- Sending `X : C` to `subobject X` is a contravariant functor `Cᵒᵖ ⥤ Type`. -/
@[simps]
def functor [HasPullbacks C] : Cᵒᵖ ⥤ Type max u₁ v₁
    where
  obj X := Subobject X.unop
  map X Y f := (pullback f.unop).obj
  map_id' X := funext pullback_id
  map_comp' X Y Z f g := funext (pullback_comp _ _)
#align category_theory.subobject.functor CategoryTheory.Subobject.functor

end Functor

section SemilatticeInfTop

variable [HasPullbacks C]

/-- The functorial infimum on `mono_over A` descends to an infimum on `subobject A`. -/
def inf {A : C} : Subobject A ⥤ Subobject A ⥤ Subobject A :=
  ThinSkeleton.map₂ MonoOver.inf
#align category_theory.subobject.inf CategoryTheory.Subobject.inf

theorem inf_le_left {A : C} (f g : Subobject A) : (inf.obj f).obj g ≤ f :=
  Quotient.inductionOn₂' f g fun a b => ⟨MonoOver.infLeLeft _ _⟩
#align category_theory.subobject.inf_le_left CategoryTheory.Subobject.inf_le_left

theorem inf_le_right {A : C} (f g : Subobject A) : (inf.obj f).obj g ≤ g :=
  Quotient.inductionOn₂' f g fun a b => ⟨MonoOver.infLeRight _ _⟩
#align category_theory.subobject.inf_le_right CategoryTheory.Subobject.inf_le_right

theorem le_inf {A : C} (h f g : Subobject A) : h ≤ f → h ≤ g → h ≤ (inf.obj f).obj g :=
  Quotient.inductionOn₃' h f g
    (by
      rintro f g h ⟨k⟩ ⟨l⟩
      exact ⟨mono_over.le_inf _ _ _ k l⟩)
#align category_theory.subobject.le_inf CategoryTheory.Subobject.le_inf

instance {B : C} : SemilatticeInf (Subobject B) :=
  { Subobject.partialOrder _ with
    inf := fun m n => (inf.obj m).obj n
    inf_le_left := inf_le_left
    inf_le_right := inf_le_right
    le_inf := le_inf }

theorem factors_left_of_inf_factors {A B : C} {X Y : Subobject B} {f : A ⟶ B}
    (h : (X ⊓ Y).Factors f) : X.Factors f :=
  factors_of_le _ (inf_le_left _ _) h
#align category_theory.subobject.factors_left_of_inf_factors CategoryTheory.Subobject.factors_left_of_inf_factors

theorem factors_right_of_inf_factors {A B : C} {X Y : Subobject B} {f : A ⟶ B}
    (h : (X ⊓ Y).Factors f) : Y.Factors f :=
  factors_of_le _ (inf_le_right _ _) h
#align category_theory.subobject.factors_right_of_inf_factors CategoryTheory.Subobject.factors_right_of_inf_factors

@[simp]
theorem inf_factors {A B : C} {X Y : Subobject B} (f : A ⟶ B) :
    (X ⊓ Y).Factors f ↔ X.Factors f ∧ Y.Factors f :=
  ⟨fun h => ⟨factors_left_of_inf_factors h, factors_right_of_inf_factors h⟩,
    by
    revert X Y
    refine' Quotient.ind₂' _
    rintro X Y ⟨⟨g₁, rfl⟩, ⟨g₂, hg₂⟩⟩
    exact ⟨_, pullback.lift_snd_assoc _ _ hg₂ _⟩⟩
#align category_theory.subobject.inf_factors CategoryTheory.Subobject.inf_factors

theorem inf_arrow_factors_left {B : C} (X Y : Subobject B) : X.Factors (X ⊓ Y).arrow :=
  (factors_iff _ _).mpr ⟨ofLe (X ⊓ Y) X (inf_le_left X Y), by simp⟩
#align category_theory.subobject.inf_arrow_factors_left CategoryTheory.Subobject.inf_arrow_factors_left

theorem inf_arrow_factors_right {B : C} (X Y : Subobject B) : Y.Factors (X ⊓ Y).arrow :=
  (factors_iff _ _).mpr ⟨ofLe (X ⊓ Y) Y (inf_le_right X Y), by simp⟩
#align category_theory.subobject.inf_arrow_factors_right CategoryTheory.Subobject.inf_arrow_factors_right

@[simp]
theorem finset_inf_factors {I : Type _} {A B : C} {s : Finset I} {P : I → Subobject B} (f : A ⟶ B) :
    (s.inf P).Factors f ↔ ∀ i ∈ s, (P i).Factors f := by
  classical
    apply Finset.induction_on s
    · simp [top_factors]
    · intro i s nm ih
      simp [ih]
#align category_theory.subobject.finset_inf_factors CategoryTheory.Subobject.finset_inf_factors

-- `i` is explicit here because often we'd like to defer a proof of `m`
theorem finset_inf_arrow_factors {I : Type _} {B : C} (s : Finset I) (P : I → Subobject B) (i : I)
    (m : i ∈ s) : (P i).Factors (s.inf P).arrow :=
  by
  revert i m
  classical
    apply Finset.induction_on s
    · rintro _ ⟨⟩
    · intro i s nm ih j m
      rw [Finset.inf_insert]
      simp only [Finset.mem_insert] at m
      rcases m with (rfl | m)
      · rw [← factor_thru_arrow _ _ (inf_arrow_factors_left _ _)]
        exact factors_comp_arrow _
      · rw [← factor_thru_arrow _ _ (inf_arrow_factors_right _ _)]
        apply factors_of_factors_right
        exact ih _ m
#align category_theory.subobject.finset_inf_arrow_factors CategoryTheory.Subobject.finset_inf_arrow_factors

theorem inf_eq_map_pullback' {A : C} (f₁ : MonoOver A) (f₂ : Subobject A) :
    (Subobject.inf.obj (Quotient.mk'' f₁)).obj f₂ =
      (Subobject.map f₁.arrow).obj ((Subobject.pullback f₁.arrow).obj f₂) :=
  by
  apply Quotient.inductionOn' f₂
  intro f₂
  rfl
#align category_theory.subobject.inf_eq_map_pullback' CategoryTheory.Subobject.inf_eq_map_pullback'

theorem inf_eq_map_pullback {A : C} (f₁ : MonoOver A) (f₂ : Subobject A) :
    (Quotient.mk'' f₁ ⊓ f₂ : Subobject A) = (map f₁.arrow).obj ((pullback f₁.arrow).obj f₂) :=
  inf_eq_map_pullback' f₁ f₂
#align category_theory.subobject.inf_eq_map_pullback CategoryTheory.Subobject.inf_eq_map_pullback

theorem prod_eq_inf {A : C} {f₁ f₂ : Subobject A} [HasBinaryProduct f₁ f₂] : (f₁ ⨯ f₂) = f₁ ⊓ f₂ :=
  le_antisymm (le_inf Limits.prod.fst.le Limits.prod.snd.le)
    (prod.lift inf_le_left.Hom inf_le_right.Hom).le
#align category_theory.subobject.prod_eq_inf CategoryTheory.Subobject.prod_eq_inf

theorem inf_def {B : C} (m m' : Subobject B) : m ⊓ m' = (inf.obj m).obj m' :=
  rfl
#align category_theory.subobject.inf_def CategoryTheory.Subobject.inf_def

/-- `⊓` commutes with pullback. -/
theorem inf_pullback {X Y : C} (g : X ⟶ Y) (f₁ f₂) :
    (pullback g).obj (f₁ ⊓ f₂) = (pullback g).obj f₁ ⊓ (pullback g).obj f₂ :=
  by
  revert f₁
  apply Quotient.ind'
  intro f₁
  erw [inf_def, inf_def, inf_eq_map_pullback', inf_eq_map_pullback', ← pullback_comp, ←
    map_pullback pullback.condition (pullback_is_pullback f₁.arrow g), ← pullback_comp,
    pullback.condition]
  rfl
#align category_theory.subobject.inf_pullback CategoryTheory.Subobject.inf_pullback

/-- `⊓` commutes with map. -/
theorem inf_map {X Y : C} (g : Y ⟶ X) [Mono g] (f₁ f₂) :
    (map g).obj (f₁ ⊓ f₂) = (map g).obj f₁ ⊓ (map g).obj f₂ :=
  by
  revert f₁
  apply Quotient.ind'
  intro f₁
  erw [inf_def, inf_def, inf_eq_map_pullback', inf_eq_map_pullback', ← map_comp]
  dsimp
  rw [pullback_comp, pullback_map_self]
#align category_theory.subobject.inf_map CategoryTheory.Subobject.inf_map

end SemilatticeInfTop

section SemilatticeSup

variable [HasImages C] [HasBinaryCoproducts C]

/-- The functorial supremum on `mono_over A` descends to an supremum on `subobject A`. -/
def sup {A : C} : Subobject A ⥤ Subobject A ⥤ Subobject A :=
  ThinSkeleton.map₂ MonoOver.sup
#align category_theory.subobject.sup CategoryTheory.Subobject.sup

instance {B : C} : SemilatticeSup (Subobject B) :=
  { Subobject.partialOrder B with
    sup := fun m n => (sup.obj m).obj n
    le_sup_left := fun m n => Quotient.inductionOn₂' m n fun a b => ⟨MonoOver.leSupLeft _ _⟩
    le_sup_right := fun m n => Quotient.inductionOn₂' m n fun a b => ⟨MonoOver.leSupRight _ _⟩
    sup_le := fun m n k =>
      Quotient.inductionOn₃' m n k fun a b c ⟨i⟩ ⟨j⟩ => ⟨MonoOver.supLe _ _ _ i j⟩ }

theorem sup_factors_of_factors_left {A B : C} {X Y : Subobject B} {f : A ⟶ B} (P : X.Factors f) :
    (X ⊔ Y).Factors f :=
  factors_of_le f le_sup_left P
#align category_theory.subobject.sup_factors_of_factors_left CategoryTheory.Subobject.sup_factors_of_factors_left

theorem sup_factors_of_factors_right {A B : C} {X Y : Subobject B} {f : A ⟶ B} (P : Y.Factors f) :
    (X ⊔ Y).Factors f :=
  factors_of_le f le_sup_right P
#align category_theory.subobject.sup_factors_of_factors_right CategoryTheory.Subobject.sup_factors_of_factors_right

variable [HasInitial C] [InitialMonoClass C]

theorem finset_sup_factors {I : Type _} {A B : C} {s : Finset I} {P : I → Subobject B} {f : A ⟶ B}
    (h : ∃ i ∈ s, (P i).Factors f) : (s.sup P).Factors f := by
  classical
    revert h
    apply Finset.induction_on s
    · rintro ⟨_, ⟨⟨⟩, _⟩⟩
    · rintro i s nm ih ⟨j, ⟨m, h⟩⟩
      simp only [Finset.sup_insert]
      simp at m
      rcases m with (rfl | m)
      · exact sup_factors_of_factors_left h
      · exact sup_factors_of_factors_right (ih ⟨j, ⟨m, h⟩⟩)
#align category_theory.subobject.finset_sup_factors CategoryTheory.Subobject.finset_sup_factors

end SemilatticeSup

section Lattice

instance [HasInitial C] [InitialMonoClass C] {B : C} : BoundedOrder (Subobject B) :=
  { Subobject.orderTop, Subobject.orderBot with }

variable [HasPullbacks C] [HasImages C] [HasBinaryCoproducts C]

instance {B : C} : Lattice (Subobject B) :=
  { Subobject.semilatticeInf, Subobject.semilatticeSup with }

end Lattice

section Inf

variable [WellPowered C]

/-- The "wide cospan" diagram, with a small indexing type, constructed from a set of subobjects.
(This is just the diagram of all the subobjects pasted together, but using `well_powered C`
to make the diagram small.)
-/
def wideCospan {A : C} (s : Set (Subobject A)) : WidePullbackShape (equivShrink _ '' s) ⥤ C :=
  WidePullbackShape.wideCospan A
    (fun j : equivShrink _ '' s => ((equivShrink (Subobject A)).symm j : C)) fun j =>
    ((equivShrink (Subobject A)).symm j).arrow
#align category_theory.subobject.wide_cospan CategoryTheory.Subobject.wideCospan

@[simp]
theorem wideCospan_map_term {A : C} (s : Set (Subobject A)) (j) :
    (wideCospan s).map (WidePullbackShape.Hom.term j) =
      ((equivShrink (Subobject A)).symm j).arrow :=
  rfl
#align category_theory.subobject.wide_cospan_map_term CategoryTheory.Subobject.wideCospan_map_term

/-- Auxiliary construction of a cone for `le_Inf`. -/
def leInfCone {A : C} (s : Set (Subobject A)) (f : Subobject A) (k : ∀ g ∈ s, f ≤ g) :
    Cone (wideCospan s) :=
  WidePullbackShape.mkCone f.arrow
    (fun j =>
      underlying.map
        (homOfLE
          (k _
            (by
              rcases j with ⟨-, ⟨g, ⟨m, rfl⟩⟩⟩
              simpa using m))))
    (by tidy)
#align category_theory.subobject.le_Inf_cone CategoryTheory.Subobject.leInfCone

@[simp]
theorem leInfCone_π_app_none {A : C} (s : Set (Subobject A)) (f : Subobject A)
    (k : ∀ g ∈ s, f ≤ g) : (leInfCone s f k).π.app none = f.arrow :=
  rfl
#align category_theory.subobject.le_Inf_cone_π_app_none CategoryTheory.Subobject.leInfCone_π_app_none

variable [HasWidePullbacks.{v₁} C]

/-- The limit of `wide_cospan s`. (This will be the supremum of the set of subobjects.)
-/
def widePullback {A : C} (s : Set (Subobject A)) : C :=
  Limits.limit (wideCospan s)
#align category_theory.subobject.wide_pullback CategoryTheory.Subobject.widePullback

/-- The inclusion map from `wide_pullback s` to `A`
-/
def widePullbackι {A : C} (s : Set (Subobject A)) : widePullback s ⟶ A :=
  Limits.limit.π (wideCospan s) none
#align category_theory.subobject.wide_pullback_ι CategoryTheory.Subobject.widePullbackι

instance widePullbackι_mono {A : C} (s : Set (Subobject A)) : Mono (widePullbackι s) :=
  ⟨fun W u v h =>
    limit.hom_ext fun j => by
      cases j
      · exact h
      · apply (cancel_mono ((equivShrink (subobject A)).symm j).arrow).1
        rw [assoc, assoc]
        erw [limit.w (wide_cospan s) (wide_pullback_shape.hom.term j)]
        exact h⟩
#align category_theory.subobject.wide_pullback_ι_mono CategoryTheory.Subobject.widePullbackι_mono

/- warning: category_theory.subobject.Inf clashes with category_theory.subobject.inf -> CategoryTheory.Subobject.inf
warning: category_theory.subobject.Inf -> CategoryTheory.Subobject.inf is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.WellPowered.{u1, u2} C _inst_1] [_inst_4 : CategoryTheory.Limits.HasWidePullbacks.{u1, u1, u2} C _inst_1] {A : C}, (Set.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 A)) -> (CategoryTheory.Subobject.{u1, u2} C _inst_1 A)
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.Limits.HasPullbacks.{u1, u2} C _inst_1] {_inst_4 : C}, CategoryTheory.Functor.{max u2 u1, max u2 u1, max u2 u1, max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4))) (CategoryTheory.Functor.{max u2 u1, max u2 u1, max u2 u1, max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4))) (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)))) (CategoryTheory.Functor.category.{max u2 u1, max u2 u1, max u2 u1, max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4))) (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4))))
Case conversion may be inaccurate. Consider using '#align category_theory.subobject.Inf CategoryTheory.Subobject.infₓ'. -/
/-- When `[well_powered C]` and `[has_wide_pullbacks C]`, `subobject A` has arbitrary infimums.
-/
def inf {A : C} (s : Set (Subobject A)) : Subobject A :=
  Subobject.mk (widePullbackι s)
#align category_theory.subobject.Inf CategoryTheory.Subobject.inf

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (f «expr ∈ » s) -/
theorem inf_le {A : C} (s : Set (Subobject A)) (f) (_ : f ∈ s) : inf s ≤ f :=
  by
  fapply le_of_comm
  · refine'
      (underlying_iso _).Hom ≫
        limits.limit.π (wide_cospan s)
            (some ⟨equivShrink _ f, Set.mem_image_of_mem (equivShrink (subobject A)) H⟩) ≫
          _
    apply eq_to_hom
    apply congr_arg fun X : subobject A => (X : C)
    exact Equiv.symm_apply_apply _ _
  · dsimp [Inf]
    simp only [category.comp_id, category.assoc, ← underlying_iso_hom_comp_eq_mk,
      subobject.arrow_congr, congr_arg_mpr_hom_left, iso.cancel_iso_hom_left]
    convert limit.w (wide_cospan s) (wide_pullback_shape.hom.term _)
#align category_theory.subobject.Inf_le CategoryTheory.Subobject.inf_le

/- warning: category_theory.subobject.le_Inf clashes with category_theory.subobject.le_inf -> CategoryTheory.Subobject.le_inf
warning: category_theory.subobject.le_Inf -> CategoryTheory.Subobject.le_inf is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.WellPowered.{u1, u2} C _inst_1] [_inst_4 : CategoryTheory.Limits.HasWidePullbacks.{u1, u1, u2} C _inst_1] {A : C} (s : Set.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 A)) (f : CategoryTheory.Subobject.{u1, u2} C _inst_1 A), (forall (g : CategoryTheory.Subobject.{u1, u2} C _inst_1 A), (Membership.Mem.{max u2 u1, max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 A) (Set.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 A)) (Set.hasMem.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 A)) g s) -> (LE.le.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 A) (Preorder.toLE.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 A) (PartialOrder.toPreorder.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 A) (CategoryTheory.Subobject.partialOrder.{u2, u1} C _inst_1 A))) f g)) -> (LE.le.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 A) (Preorder.toLE.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 A) (PartialOrder.toPreorder.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 A) (CategoryTheory.Subobject.partialOrder.{u2, u1} C _inst_1 A))) f (CategoryTheory.Subobject.inf.{u1, u2} C _inst_1 _inst_3 (fun (J : Type.{u1}) => _inst_4 J) A s))
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.Limits.HasPullbacks.{u1, u2} C _inst_1] {_inst_4 : C} (A : CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (s : CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (f : CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4), (LE.le.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (Preorder.toLE.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (PartialOrder.toPreorder.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.Subobject.partialOrder.{u2, u1} C _inst_1 _inst_4))) A s) -> (LE.le.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (Preorder.toLE.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (PartialOrder.toPreorder.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.Subobject.partialOrder.{u2, u1} C _inst_1 _inst_4))) A f) -> (LE.le.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (Preorder.toLE.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (PartialOrder.toPreorder.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.Subobject.partialOrder.{u2, u1} C _inst_1 _inst_4))) A (CategoryTheory.Functor.obj.{max u2 u1, max u2 u1, max u2 u1, max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4))) (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4))) (CategoryTheory.Functor.obj.{max u2 u1, max u2 u1, max u2 u1, max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4))) (CategoryTheory.Functor.{max u2 u1, max u2 u1, max u2 u1, max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4))) (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_4) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)))) (CategoryTheory.Functor.category.{max u2 u1, max u2 u1, max u2 u1, max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4))) (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_4) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_4)))) (CategoryTheory.Subobject.inf.{u1, u2} C _inst_1 _inst_3 _inst_4) s) f))
Case conversion may be inaccurate. Consider using '#align category_theory.subobject.le_Inf CategoryTheory.Subobject.le_infₓ'. -/
theorem le_inf {A : C} (s : Set (Subobject A)) (f : Subobject A) (k : ∀ g ∈ s, f ≤ g) : f ≤ inf s :=
  by
  fapply le_of_comm
  · exact limits.limit.lift _ (le_Inf_cone s f k) ≫ (underlying_iso _).inv
  · dsimp [Inf, wide_pullback_ι]
    simp
#align category_theory.subobject.le_Inf CategoryTheory.Subobject.le_inf

instance {B : C} : CompleteSemilatticeInf (Subobject B) :=
  { Subobject.partialOrder B with
    infₛ := inf
    inf_le := inf_le
    le_inf := le_inf }

end Inf

section Sup

variable [WellPowered C] [HasCoproducts.{v₁} C]

/-- The univesal morphism out of the coproduct of a set of subobjects,
after using `[well_powered C]` to reindex by a small type.
-/
def smallCoproductDesc {A : C} (s : Set (Subobject A)) : _ ⟶ A :=
  Limits.Sigma.desc fun j : equivShrink _ '' s => ((equivShrink (Subobject A)).symm j).arrow
#align category_theory.subobject.small_coproduct_desc CategoryTheory.Subobject.smallCoproductDesc

variable [HasImages C]

/- warning: category_theory.subobject.Sup clashes with category_theory.subobject.sup -> CategoryTheory.Subobject.sup
warning: category_theory.subobject.Sup -> CategoryTheory.Subobject.sup is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.WellPowered.{u1, u2} C _inst_1] [_inst_4 : CategoryTheory.Limits.HasCoproducts.{u1, u1, u2} C _inst_1] [_inst_5 : CategoryTheory.Limits.HasImages.{u1, u2} C _inst_1] {A : C}, (Set.{max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 A)) -> (CategoryTheory.Subobject.{u1, u2} C _inst_1 A)
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] [_inst_3 : CategoryTheory.Limits.HasImages.{u1, u2} C _inst_1] [_inst_4 : CategoryTheory.Limits.HasBinaryCoproducts.{u1, u2} C _inst_1] {_inst_5 : C}, CategoryTheory.Functor.{max u2 u1, max u2 u1, max u2 u1, max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_5) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_5) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_5)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_5) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_5))) (CategoryTheory.Functor.{max u2 u1, max u2 u1, max u2 u1, max u2 u1} (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_5) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_5) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_5)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_5) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_5))) (CategoryTheory.Subobject.{u1, u2} C _inst_1 _inst_5) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_5) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_5)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_5) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_5)))) (CategoryTheory.Functor.category.{max u2 u1, max u2 u1, max u2 u1, max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_5) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_5)) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_5) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_5)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_5) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_5))) (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_5) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_5)) (Preorder.smallCategory.{max u2 u1} (CategoryTheory.ThinSkeleton.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_5) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_5)) (CategoryTheory.ThinSkeleton.preorder.{u1, max u2 u1} (CategoryTheory.MonoOver.{u1, u2} C _inst_1 _inst_5) (CategoryTheory.MonoOver.category.{u2, u1} C _inst_1 _inst_5))))
Case conversion may be inaccurate. Consider using '#align category_theory.subobject.Sup CategoryTheory.Subobject.supₓ'. -/
/-- When `[well_powered C] [has_images C] [has_coproducts C]`,
`subobject A` has arbitrary supremums. -/
def sup {A : C} (s : Set (Subobject A)) : Subobject A :=
  Subobject.mk (image.ι (smallCoproductDesc s))
#align category_theory.subobject.Sup CategoryTheory.Subobject.sup

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (f «expr ∈ » s) -/
theorem le_sup {A : C} (s : Set (Subobject A)) (f) (_ : f ∈ s) : f ≤ sup s :=
  by
  fapply le_of_comm
  · dsimp [Sup]
    refine' _ ≫ factor_thru_image _ ≫ (underlying_iso _).inv
    refine' _ ≫ sigma.ι _ ⟨equivShrink _ f, by simpa [Set.mem_image] using H⟩
    exact eq_to_hom (congr_arg (fun X : subobject A => (X : C)) (Equiv.symm_apply_apply _ _).symm)
  · dsimp [Sup, small_coproduct_desc]
    simp
    dsimp
    simp
#align category_theory.subobject.le_Sup CategoryTheory.Subobject.le_sup

theorem symm_apply_mem_iff_mem_image {α β : Type _} (e : α ≃ β) (s : Set α) (x : β) :
    e.symm x ∈ s ↔ x ∈ e '' s :=
  ⟨fun h => ⟨e.symm x, h, by simp⟩, by
    rintro ⟨a, m, rfl⟩
    simpa using m⟩
#align category_theory.subobject.symm_apply_mem_iff_mem_image CategoryTheory.Subobject.symm_apply_mem_iff_mem_image

theorem sup_le {A : C} (s : Set (Subobject A)) (f : Subobject A) (k : ∀ g ∈ s, g ≤ f) : sup s ≤ f :=
  by
  fapply le_of_comm
  · dsimp [Sup]
    refine' (underlying_iso _).Hom ≫ image.lift ⟨_, f.arrow, _, _⟩
    · refine' sigma.desc _
      rintro ⟨g, m⟩
      refine' underlying.map (hom_of_le (k _ _))
      simpa [symm_apply_mem_iff_mem_image] using m
    · ext j
      rcases j with ⟨j, m⟩
      dsimp [small_coproduct_desc]
      simp
      dsimp
      simp
  · dsimp [Sup]
    simp
#align category_theory.subobject.Sup_le CategoryTheory.Subobject.sup_le

instance {B : C} : CompleteSemilatticeSup (Subobject B) :=
  { Subobject.partialOrder B with
    supₛ := sup
    le_sup := le_sup
    sup_le := sup_le }

end Sup

section CompleteLattice

variable [WellPowered C] [HasWidePullbacks.{v₁} C] [HasImages C] [HasCoproducts.{v₁} C]
  [InitialMonoClass C]

attribute [local instance] has_smallest_coproducts_of_has_coproducts

instance {B : C} : CompleteLattice (Subobject B) :=
  { Subobject.semilatticeInf, Subobject.semilatticeSup, Subobject.boundedOrder,
    Subobject.completeSemilatticeInf, Subobject.completeSemilatticeSup with }

end CompleteLattice

section ZeroObject

variable [HasZeroMorphisms C] [HasZeroObject C]

open ZeroObject

/-- A nonzero object has nontrivial subobject lattice. -/
theorem nontrivial_of_not_isZero {X : C} (h : ¬IsZero X) : Nontrivial (Subobject X) :=
  ⟨⟨mk (0 : 0 ⟶ X), mk (𝟙 X), fun w => h (IsZero.of_iso (isZero_zero C) (isoOfMkEqMk _ _ w).symm)⟩⟩
#align category_theory.subobject.nontrivial_of_not_is_zero CategoryTheory.Subobject.nontrivial_of_not_isZero

end ZeroObject

section SubobjectSubobject

/-- The subobject lattice of a subobject `Y` is order isomorphic to the interval `set.Iic Y`. -/
def subobjectOrderIso {X : C} (Y : Subobject X) : Subobject (Y : C) ≃o Set.Iic Y
    where
  toFun Z :=
    ⟨Subobject.mk (Z.arrow ≫ Y.arrow),
      Set.mem_Iic.mpr (le_of_comm ((underlyingIso _).Hom ≫ Z.arrow) (by simp))⟩
  invFun Z := Subobject.mk (ofLe _ _ Z.2)
  left_inv Z :=
    mk_eq_of_comm _ (underlyingIso _)
      (by
        ext
        simp)
  right_inv Z :=
    Subtype.ext
      (mk_eq_of_comm _ (underlyingIso _)
        (by
          dsimp
          simp [← iso.eq_inv_comp]))
  map_rel_iff' W Z :=
    ⟨fun h =>
      le_of_comm ((underlyingIso _).inv ≫ ofLe _ _ (Subtype.mk_le_mk.mp h) ≫ (underlyingIso _).Hom)
        (by
          ext
          simp),
      fun h =>
      Subtype.mk_le_mk.mpr
        (le_of_comm ((underlyingIso _).Hom ≫ ofLe _ _ h ≫ (underlyingIso _).inv) (by simp))⟩
#align category_theory.subobject.subobject_order_iso CategoryTheory.Subobject.subobjectOrderIso

end SubobjectSubobject

end Subobject

end CategoryTheory