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

From: https://github.com/leanprover-community/mathlib/pull/10255
-/

import linear_algebra.pi_tensor_product
import logic.equiv.fin

import cicm2022.examples.tuple
import cicm2022.external.graded_algebra

/-!
# Tensor power of a semimodule over a commutative semirings

We define the `n`th tensor power of `M` as the n-ary tensor product indexed by `fin n` of `M`,
`⨂[R] (i : fin n), M`. This is a special case of `pi_tensor_product`.

This file introduces the notation `⨂[R]^n M` for `tensor_power R n M`, which in turn is an
abbreviation for `⨂[R] i : fin n, M`.

## Main definitions:

* `tensor_power.gsemiring`: the tensor powers form a graded semiring.
* `tensor_power.galgebra`: the tensor powers form a graded algebra.

## Implementation notes

In this file we use `ₜ1` and `ₜ*` as local notation for the graded multiplicative structure on
tensor powers. Elsewhere, using `1` and `*` on `graded_monoid` should be preferred.
-/

open_locale tensor_product

/-- Homogenous tensor powers $M^{\otimes n}$. `⨂[R]^n M` is a shorthand for
`⨂[R] (i : fin n), M`. -/
@[reducible] protected def tensor_power (R : Type*) (n : ℕ) (M : Type*)
  [comm_semiring R] [add_comm_monoid M] [module R M] : Type* :=
⨂[R] i : fin n, M

variables {R : Type*} {M : Type*} [comm_semiring R] [add_comm_monoid M] [module R M]

localized "notation `⨂[`:100 R `]^`:80 n:max := tensor_power R n"
  in tensor_product

namespace pi_tensor_product

@[ext]
lemma sigma_eq_of_reindex_cast {ιι : Type*} {ι : ιι → Type*} [dι : ∀ ii, decidable_eq (ι ii)] :
  ∀ {a b : Σ ii, ⨂[R] i : ι ii, M} (h : a.fst = b.fst),
    reindex R M (equiv.cast $ congr_arg ι h) a.snd = b.snd → a = b
| ⟨ai, a⟩ ⟨bi, b⟩ := λ (hi : ai = bi) (h : reindex R M _ a = b),
begin
  subst hi,
  simpa using h,
end

end pi_tensor_product

namespace tensor_power
open_locale tensor_product direct_sum
open pi_tensor_product

/-- As a graded monoid, `⨂[R]^i M` has a `1 : ⨂[R]^0 M`. -/
instance ghas_one : graded_monoid.ghas_one (λ i, ⨂[R]^i M) :=
{ one := tprod R fin.elim0 }

local notation `ₜ1` := @graded_monoid.ghas_one.one ℕ (λ i, ⨂[R]^i M) _ _

lemma ghas_one_def : ₜ1 = tprod R fin.elim0 := rfl

/-- A variant of `pi_tensor_prod.tmul_equiv` with the result indexed by `fin (n + m)`. -/
def mul_equiv {n m : ℕ} : (⨂[R]^n M) ⊗[R] (⨂[R]^m M) ≃ₗ[R] ⨂[R]^(n + m) M :=
(tmul_equiv R M).trans (reindex R M fin_sum_fin_equiv)

/-- As a graded monoid, `⨂[R]^i M` has a `(*) : ⨂[R]^i M → ⨂[R]^j M → ⨂[R]^(i + j) M`. -/
instance ghas_mul : graded_monoid.ghas_mul (λ i, ⨂[R]^i M) :=
{ mul := λ i j a b, (tensor_product.mk R _ _).compr₂ ↑(mul_equiv : _ ≃ₗ[R] ⨂[R]^(i + j) M) a b}

local infix `ₜ*`:70 := @graded_monoid.ghas_mul.mul ℕ (λ i, ⨂[R]^i M) _ _ _ _

lemma ghas_mul_def {i j} (a : ⨂[R]^i M) (b : ⨂[R]^j M) : a ₜ* b = mul_equiv (a ⊗ₜ b) := rfl

lemma ghas_mul_eq_coe_linear_map {i j} (a : ⨂[R]^i M) (b : ⨂[R]^j M) :
  a ₜ* b =
    ((tensor_product.mk R _ _).compr₂ ↑(mul_equiv : _ ≃ₗ[R] ⨂[R]^(i + j) M)
      : ⨂[R]^i M →ₗ[R] ⨂[R]^j M →ₗ[R] ⨂[R]^(i + j) M) a b := rfl

variables (R M)

/-- Cast between "equal" tensor powers. -/
def cast {i j} (h : i = j) : ⨂[R]^i M ≃ₗ[R] (⨂[R]^j M) :=
reindex R M (fin.cast h).to_equiv

lemma cast_tprod {i j} (h : i = j) (a : fin i → M) :
  cast R M h (tprod R a) = tprod R (a ∘ fin.cast h.symm) :=
reindex_tprod _ _

@[simp] lemma cast_refl {i} (h : i = i) : (cast R M h) = linear_equiv.refl _ _ :=
begin
  refine eq.trans _ (reindex_refl),
  rw cast,
  refine congr_arg (reindex R M) _,
  rw fin.cast_refl,
  refl,
end

@[simp] lemma cast_symm {i j} (h : i = j) : (cast R M h).symm = cast R M h.symm := reindex_symm _

@[simp] lemma cast_trans {i j k} (h : i = j) (h' : j = k) :
  (cast R M h).trans (cast R M h') = cast R M (h.trans h') := reindex_trans _ _

variables {R M}

@[simp] lemma cast_cast {i j k} (h : i = j) (h' : j = k) (a : ⨂[R]^i M) :
  cast R M h' (cast R M h a) = cast R M (h.trans h') a := reindex_reindex _ _ _

@[ext]
lemma graded_monoid_eq_of_cast {a b : graded_monoid (λ n, ⨂[R] i : fin n, M)}
  (h : a.fst = b.fst) (h2 : cast R M h a.snd = b.snd) : a = b :=
begin
  refine sigma_eq_of_reindex_cast h _,
  rw cast at h2,
  rw [←fin.cast_to_equiv, ← h2],
end

lemma cast_eq_cast {i j} (h : i = j) : ⇑(cast R M h) = _root_.cast (congr_arg _ h) :=
begin
  subst h,
  rw [cast_refl],
  refl,
end

variables (R)
include R
lemma tprod_mul_tprod {na nb} (a : fin na → M) (b : fin nb → M) :
  tprod R a ₜ* tprod R b = (tprod R $ fin.append' a b) :=
begin
  dsimp [ghas_mul_def, mul_equiv],
  rw [tmul_equiv_apply R M a b],
  refine (reindex_tprod _ _).trans _,
  congr' 1,
  dsimp only [fin.append', fin_sum_fin_equiv, equiv.coe_fn_symm_mk],
  apply funext,
  apply fin.add_cases; simp,
end
omit R
variables {R}

lemma one_mul {n} (a : ⨂[R]^n M) :
  cast R M (zero_add n) (ₜ1 ₜ* a) = a :=
begin
  rw [ghas_mul_def, ghas_one_def],
  induction a using pi_tensor_product.induction_on with r a x y hx hy,
  { dsimp only at a,
    rw [tensor_product.tmul_smul, linear_equiv.map_smul, linear_equiv.map_smul, ←ghas_mul_def,
      tprod_mul_tprod, cast_tprod],
    congr' 2 with i,
    rw fin.elim0_append',
    refine congr_arg a (fin.ext _),
    simp },
  { rw [tensor_product.tmul_add, map_add, map_add, hx, hy], },
end

lemma mul_one {n} (a : ⨂[R]^n M) : cast R M (add_zero _) (a ₜ* ₜ1) = a :=
begin
  rw [ghas_mul_def, ghas_one_def],
  induction a using pi_tensor_product.induction_on with r a x y hx hy,
  { dsimp only at a,
    rw [←tensor_product.smul_tmul', linear_equiv.map_smul, linear_equiv.map_smul, ←ghas_mul_def,
      tprod_mul_tprod R a _, cast_tprod],
    congr' 2 with i,
    rw fin.append'_elim0,
    refine congr_arg a (fin.ext _),
    simp },
  { rw [tensor_product.add_tmul, map_add, map_add, hx, hy], },
end

lemma mul_assoc {na nb nc} (a : ⨂[R]^na M) (b : ⨂[R]^nb M) (c : ⨂[R]^nc M) :
  cast R M (add_assoc _ _ _) ((a ₜ* b) ₜ* c) = a ₜ* (b  ₜ* c) :=
begin
  let mul : Π (n m : ℕ), (⨂[R]^n M) →ₗ[R] (⨂[R]^m M) →ₗ[R] ⨂[R]^(n + m) M :=
    (λ n m, (tensor_product.mk R _ _).compr₂ ↑(mul_equiv : _ ≃ₗ[R] ⨂[R]^(n + m) M)),
  -- replace `a`, `b`, `c` with `tprod R a`, `tprod R b`, `tprod R c`
  let e : ⨂[R]^(na + nb + nc) M ≃ₗ[R] ⨂[R]^(na + (nb + nc)) M := cast R M (add_assoc _ _ _),
  let lhs : (⨂[R]^na M) →ₗ[R] (⨂[R]^nb M) →ₗ[R] (⨂[R]^nc M) →ₗ[R] (⨂[R]^(na + (nb + nc)) M) :=
    (linear_map.llcomp R _ _ _ ((mul _ nc).compr₂ e.to_linear_map)).comp
      (mul na nb),
  have lhs_eq : ∀ a b c, lhs a b c = e ((a ₜ* b) ₜ* c) := λ _ _ _, rfl,
  let rhs : (⨂[R]^na M) →ₗ[R] (⨂[R]^nb M) →ₗ[R] (⨂[R]^nc M) →ₗ[R] (⨂[R]^(na + (nb + nc)) M) :=
    (linear_map.llcomp R _ _ _ (linear_map.lflip R _ _ _) $
      (linear_map.llcomp R _ _ _ (mul na _).flip).comp (mul nb nc)).flip,
  have rhs_eq : ∀ a b c, rhs a b c = (a ₜ* (b ₜ* c)) := λ _ _ _, rfl,
  suffices : lhs = rhs,
  from linear_map.congr_fun (linear_map.congr_fun (linear_map.congr_fun this a) b) c,
  ext a b c,
  -- clean up
  simp only [linear_map.comp_multilinear_map_apply, lhs_eq, rhs_eq, tprod_mul_tprod, e,
    cast_tprod],
  congr' with j,
  rw fin.append'_assoc,
  refine congr_arg (fin.append' a (fin.append' b c)) (fin.ext _),
  rw [fin.coe_cast, fin.coe_cast],
end

-- for now we just use the default for the `gnpow` field as it's easier.
instance gmonoid : graded_monoid.gmonoid (λ i, ⨂[R]^i M) :=
{ one_mul := λ a, graded_monoid_eq_of_cast (zero_add _) (one_mul _), --(one_mul _),
  mul_one := λ a, graded_monoid_eq_of_cast (add_zero _) (mul_one _), --(mul_one _),
  mul_assoc := λ a b c, graded_monoid_eq_of_cast (add_assoc _ _ _) (mul_assoc _ _ _),
  ..tensor_power.ghas_mul,
  ..tensor_power.ghas_one, }

/-- The canonical map from `R` to `⨂[R]^0 M` corresponding to the algebra_map of the tensor
algebra. -/
def algebra_map : R ≃ₗ[R] ⨂[R]^0 M :=
linear_equiv.symm $ is_empty_equiv (fin 0)

lemma algebra_map_eq_smul_one (r : R) :
  (algebra_map r : ⨂[R]^0 M) = r • ₜ1 :=
by { simp [algebra_map], congr }

lemma algebra_map_mul {n} (r : R) (a : ⨂[R]^n M) :
  cast R M (zero_add _) (algebra_map r ₜ* a) = r • a :=
by rw [ghas_mul_eq_coe_linear_map, algebra_map_eq_smul_one, linear_map.map_smul₂,
  linear_equiv.map_smul,  ←ghas_mul_eq_coe_linear_map, one_mul]

lemma mul_algebra_map {n} (r : R) (a : ⨂[R]^n M) :
  cast R M (add_zero _) (a ₜ* algebra_map r) = r • a :=
by rw [ghas_mul_eq_coe_linear_map, algebra_map_eq_smul_one, linear_map.map_smul,
  linear_equiv.map_smul, ←ghas_mul_eq_coe_linear_map, mul_one]

lemma algebra_map_mul_algebra_map (r s : R) :
  cast R M (add_zero _) (algebra_map r ₜ* algebra_map s) = algebra_map (r * s) :=
begin
  rw [←smul_eq_mul, linear_equiv.map_smul],
  exact algebra_map_mul r (@algebra_map R M _ _ _ s),
end

instance gsemiring : direct_sum.gsemiring (λ i, ⨂[R]^i M) :=
{ mul_zero := λ i j a, linear_map.map_zero _,
  zero_mul := λ i j b, linear_map.map_zero₂ _ _,
  mul_add := λ i j a b₁ b₂, linear_map.map_add _ _ _,
  add_mul := λ i j a₁ a₂ b, linear_map.map_add₂ _ _ _ _,
  nat_cast := λ n, (tensor_power.algebra_map : R ≃ₗ[R] ⨂[R]^0 M) n,
  nat_cast_zero := by simp,
  nat_cast_succ := λ n, by rw [nat.cast_add, nat.cast_one, map_add,
    algebra_map_eq_smul_one (1 : R), one_smul],
  ..tensor_power.gmonoid }

example : semiring (⨁ n : ℕ, ⨂[R]^n M) := by apply_instance

instance galgebra : direct_sum.galgebra R (λ i, ⨂[R]^i M) :=
{ to_fun := (tensor_power.algebra_map : R ≃ₗ[R] ⨂[R]^0 M) .to_linear_map.to_add_monoid_hom,
  map_one := (algebra_map_eq_smul_one 1).trans (one_smul _ _),
  map_mul := λ r s, graded_monoid_eq_of_cast rfl begin
    rw [←linear_equiv.eq_symm_apply],
    have := algebra_map_mul_algebra_map r s,
    exact this.symm,
  end,
  commutes := λ r x, graded_monoid_eq_of_cast (add_comm _ _) begin
    have := (algebra_map_mul r x.snd).trans (mul_algebra_map r x.snd).symm,
    rw [←linear_equiv.eq_symm_apply, cast_symm],
    rw [←linear_equiv.eq_symm_apply, cast_symm, cast_cast] at this,
    exact this,
  end,
  smul_def := λ r x, graded_monoid_eq_of_cast (zero_add x.fst).symm begin
    rw [←linear_equiv.eq_symm_apply, cast_symm],
    exact (algebra_map_mul r x.snd).symm,
  end }

lemma galgebra_to_fun_def (r : R) :
  @direct_sum.galgebra.to_fun ℕ R (λ i, ⨂[R]^i M) _ _ _ _ _ _ _ r = algebra_map r := rfl

example : algebra R (⨁ n : ℕ, ⨂[R]^n M) := by apply_instance

end tensor_power


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Seul Baek
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.omega.clause
import Mathlib.tactic.omega.nat.form
import Mathlib.PostPort

namespace Mathlib

/-
DNF transformation.
-/

namespace omega

namespace nat

@[simp] def dnf_core : preform → List clause := sorry

theorem exists_clause_holds_core {v : ℕ → ℕ} {p : preform} :
    preform.neg_free p →
        preform.sub_free p →
          preform.holds v p →
            ∃ (c : clause), ∃ (H : c ∈ dnf_core p), clause.holds (fun (x : ℕ) => ↑(v x)) c :=
  sorry

def term.vars_core (is : List ℤ) : List Bool := list.map (fun (i : ℤ) => ite (i = 0) false tt) is

/-- Return a list of bools that encodes which variables have nonzero coefficients -/
def term.vars (t : term) : List Bool := term.vars_core (prod.snd t)

def bools.or : List Bool → List Bool → List Bool := sorry

/-- Return a list of bools that encodes which variables have nonzero coefficients in any one of the input terms -/
def terms.vars : List term → List Bool := sorry

def nonneg_consts_core : ℕ → List Bool → List term := sorry

def nonneg_consts (bs : List Bool) : List term := nonneg_consts_core 0 bs

def nonnegate : clause → clause := sorry

/-- DNF transformation -/
def dnf (p : preform) : List clause := list.map nonnegate (dnf_core p)

theorem holds_nonneg_consts_core {v : ℕ → ℤ} (h1 : ∀ (x : ℕ), 0 ≤ v x) (m : ℕ) (bs : List Bool)
    (t : term) (H : t ∈ nonneg_consts_core m bs) : 0 ≤ term.val v t :=
  sorry

theorem holds_nonneg_consts {v : ℕ → ℤ} {bs : List Bool} :
    (∀ (x : ℕ), 0 ≤ v x) → ∀ (t : term), t ∈ nonneg_consts bs → 0 ≤ term.val v t :=
  fun (ᾰ : ∀ (x : ℕ), 0 ≤ v x) =>
    idRhs (∀ (t : term), t ∈ nonneg_consts_core 0 bs → 0 ≤ term.val (fun (x : ℕ) => v x) t)
      (holds_nonneg_consts_core ᾰ 0 bs)

theorem exists_clause_holds {v : ℕ → ℕ} {p : preform} :
    preform.neg_free p →
        preform.sub_free p →
          preform.holds v p →
            ∃ (c : clause), ∃ (H : c ∈ dnf p), clause.holds (fun (x : ℕ) => ↑(v x)) c :=
  sorry

theorem exists_clause_sat {p : preform} :
    preform.neg_free p →
        preform.sub_free p → preform.sat p → ∃ (c : clause), ∃ (H : c ∈ dnf p), clause.sat c :=
  sorry

theorem unsat_of_unsat_dnf (p : preform) :
    preform.neg_free p → preform.sub_free p → clauses.unsat (dnf p) → preform.unsat p :=
  fun (hnf : preform.neg_free p) (hsf : preform.sub_free p) (h1 : clauses.unsat (dnf p)) =>
    id fun (h2 : preform.sat p) => h1 (exists_clause_sat hnf hsf h2)

end Mathlib


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

import topology.sheaves.sheaf
import category_theory.limits.preserves.basic
import category_theory.category.pairwise

/-!
# Equivalent formulations of the sheaf condition

We give an equivalent formulation of the sheaf condition.

Given any indexed type `ι`, we define `overlap ι`,
a category with objects corresponding to
* individual open sets, `single i`, and
* intersections of pairs of open sets, `pair i j`,
with morphisms from `pair i j` to both `single i` and `single j`.

Any open cover `U : ι → opens X` provides a functor `diagram U : overlap ι ⥤ (opens X)ᵒᵖ`.

There is a canonical cone over this functor, `cone U`, whose cone point is `supr U`,
and in fact this is a limit cone.

A presheaf `F : presheaf C X` is a sheaf precisely if it preserves this limit.
We express this in two equivalent ways, as
* `is_limit (F.map_cone (cone U))`, or
* `preserves_limit (diagram U) F`
-/

noncomputable theory

universes v u

open topological_space
open Top
open opposite
open category_theory
open category_theory.limits

namespace Top.presheaf

variables {X : Top.{v}}

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

/--
An alternative formulation of the sheaf condition
(which we prove equivalent to the usual one below as
`is_sheaf_iff_is_sheaf_pairwise_intersections`).

A presheaf is a sheaf if `F` sends the cone `(pairwise.cocone U).op` to a limit cone.
(Recall `pairwise.cocone U` has cone point `supr U`, mapping down to the `U i` and the `U i ⊓ U j`.)
-/
def is_sheaf_pairwise_intersections (F : presheaf C X) : Prop :=
∀ ⦃ι : Type v⦄ (U : ι → opens X), nonempty (is_limit (F.map_cone (pairwise.cocone U).op))

/--
An alternative formulation of the sheaf condition
(which we prove equivalent to the usual one below as
`is_sheaf_iff_is_sheaf_preserves_limit_pairwise_intersections`).

A presheaf is a sheaf if `F` preserves the limit of `pairwise.diagram U`.
(Recall `pairwise.diagram U` is the diagram consisting of the pairwise intersections
`U i ⊓ U j` mapping into the open sets `U i`. This diagram has limit `supr U`.)
-/
def is_sheaf_preserves_limit_pairwise_intersections (F : presheaf C X) : Prop :=
∀ ⦃ι : Type v⦄ (U : ι → opens X), nonempty (preserves_limit (pairwise.diagram U).op F)

/-!
The remainder of this file shows that these conditions are equivalent
to the usual sheaf condition.
-/

variables [has_products C]

namespace sheaf_condition_pairwise_intersections

open category_theory.pairwise category_theory.pairwise.hom
open sheaf_condition_equalizer_products

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_functor_obj (F : presheaf C X)
  ⦃ι : Type v⦄ (U : ι → opens ↥X) (c : limits.cone ((diagram U).op ⋙ F)) :
  limits.cone (sheaf_condition_equalizer_products.diagram F U) :=
{ X := c.X,
  π :=
  { app := λ Z,
      walking_parallel_pair.cases_on Z
        (pi.lift (λ (i : ι), c.π.app (op (single i))))
        (pi.lift (λ (b : ι × ι), c.π.app (op (pair b.1 b.2)))),
    naturality' := λ Y Z f,
    begin
      cases Y; cases Z; cases f,
      { ext i, dsimp,
        simp only [limit.lift_π, category.id_comp, fan.mk_π_app, category_theory.functor.map_id,
          category.assoc],
        dsimp,
        simp only [limit.lift_π, category.id_comp, fan.mk_π_app], },
      { ext ⟨i, j⟩, dsimp [sheaf_condition_equalizer_products.left_res],
        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
          category.assoc],
        have h := c.π.naturality (quiver.hom.op (hom.left i j)),
        dsimp at h,
        simpa using h, },
      { ext ⟨i, j⟩, dsimp [sheaf_condition_equalizer_products.right_res],
        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
          category.assoc],
        have h := c.π.naturality (quiver.hom.op (hom.right i j)),
        dsimp at h,
        simpa using h, },
      { ext i, dsimp,
        simp only [limit.lift_π, category.id_comp, fan.mk_π_app, category_theory.functor.map_id,
          category.assoc],
        dsimp,
        simp only [limit.lift_π, category.id_comp, fan.mk_π_app], },
    end, }, }

section
local attribute [tidy] tactic.case_bash

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_functor (F : presheaf C X)
  ⦃ι : Type v⦄ (U : ι → opens ↥X) :
  limits.cone ((diagram U).op ⋙ F) ⥤
    limits.cone (sheaf_condition_equalizer_products.diagram F U) :=
{ obj := λ c, cone_equiv_functor_obj F U c,
  map := λ c c' f,
  { hom := f.hom,
    w' := λ j, begin
      cases j;
      { ext, simp only [limits.fan.mk_π_app, limits.cone_morphism.w,
        limits.limit.lift_π, category.assoc, cone_equiv_functor_obj_π_app], },
    end }, }.

end

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_inverse_obj (F : presheaf C X)
  ⦃ι : Type v⦄ (U : ι → opens ↥X)
  (c : limits.cone (sheaf_condition_equalizer_products.diagram F U)) :
  limits.cone ((diagram U).op ⋙ F) :=
{ X := c.X,
  π :=
  { app :=
    begin
      intro x,
      induction x using opposite.rec,
      rcases x with (⟨i⟩|⟨i,j⟩),
      { exact c.π.app (walking_parallel_pair.zero) ≫ pi.π _ i, },
      { exact c.π.app (walking_parallel_pair.one) ≫ pi.π _ (i, j), }
    end,
    naturality' :=
    begin
      intros x y f,
      induction x using opposite.rec,
      induction y using opposite.rec,
      have ef : f = f.unop.op := rfl,
      revert ef,
      generalize : f.unop = f',
      rintro rfl,
      rcases x with ⟨i⟩|⟨⟩; rcases y with ⟨⟩|⟨j,j⟩; rcases f' with ⟨⟩,
      { dsimp, erw [F.map_id], simp, },
      { dsimp, simp only [category.id_comp, category.assoc],
        have h := c.π.naturality (walking_parallel_pair_hom.left),
        dsimp [sheaf_condition_equalizer_products.left_res] at h,
        simp only [category.id_comp] at h,
        have h' := h =≫ pi.π _ (i, j),
        rw h',
        simp,
        refl, },
      { dsimp, simp only [category.id_comp, category.assoc],
        have h := c.π.naturality (walking_parallel_pair_hom.right),
        dsimp [sheaf_condition_equalizer_products.right_res] at h,
        simp only [category.id_comp] at h,
        have h' := h =≫ pi.π _ (j, i),
        rw h',
        simp,
        refl, },
      { dsimp, erw [F.map_id], simp, },
    end, }, }

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_inverse (F : presheaf C X)
  ⦃ι : Type v⦄ (U : ι → opens ↥X) :
  limits.cone (sheaf_condition_equalizer_products.diagram F U) ⥤
    limits.cone ((diagram U).op ⋙ F) :=
{ obj := λ c, cone_equiv_inverse_obj F U c,
  map := λ c c' f,
  { hom := f.hom,
    w' :=
    begin
      intro x,
      induction x using opposite.rec,
      rcases x with (⟨i⟩|⟨i,j⟩),
      { dsimp,
        rw [←(f.w walking_parallel_pair.zero), category.assoc], },
      { dsimp,
        rw [←(f.w walking_parallel_pair.one), category.assoc], },
    end }, }.

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_unit_iso_app (F : presheaf C X) ⦃ι : Type v⦄ (U : ι → opens ↥X)
  (c : cone ((diagram U).op ⋙ F)) :
  (𝟭 (cone ((diagram U).op ⋙ F))).obj c ≅
    (cone_equiv_functor F U ⋙ cone_equiv_inverse F U).obj c :=
{ hom :=
  { hom := 𝟙 _,
    w' := λ j, begin
      induction j using opposite.rec, rcases j;
      { dsimp, simp only [limits.fan.mk_π_app, category.id_comp, limits.limit.lift_π], }
    end, },
  inv :=
  { hom := 𝟙 _,
    w' := λ j, begin
      induction j using opposite.rec, rcases j;
      { dsimp, simp only [limits.fan.mk_π_app, category.id_comp, limits.limit.lift_π], }
    end },
  hom_inv_id' := begin
    ext,
    simp only [category.comp_id, limits.cone.category_comp_hom, limits.cone.category_id_hom],
  end,
  inv_hom_id' := begin
    ext,
    simp only [category.comp_id, limits.cone.category_comp_hom, limits.cone.category_id_hom],
  end, }

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_unit_iso (F : presheaf C X) ⦃ι : Type v⦄ (U : ι → opens X) :
  𝟭 (limits.cone ((diagram U).op ⋙ F)) ≅
    cone_equiv_functor F U ⋙ cone_equiv_inverse F U :=
nat_iso.of_components (cone_equiv_unit_iso_app F U) (by tidy)

/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
@[simps]
def cone_equiv_counit_iso (F : presheaf C X) ⦃ι : Type v⦄ (U : ι → opens X) :
  cone_equiv_inverse F U ⋙ cone_equiv_functor F U ≅
    𝟭 (limits.cone (sheaf_condition_equalizer_products.diagram F U)) :=
nat_iso.of_components (λ c,
{ hom :=
  { hom := 𝟙 _,
    w' :=
    begin
      rintro ⟨_|_⟩,
      { ext, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
      { ext ⟨i,j⟩, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
    end },
  inv :=
  { hom := 𝟙 _,
    w' :=
    begin
      rintro ⟨_|_⟩,
      { ext, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
      { ext ⟨i,j⟩, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
    end, },
  hom_inv_id' := by { ext, dsimp, simp only [category.comp_id], },
  inv_hom_id' := by { ext, dsimp, simp only [category.comp_id], }, })
(λ c d f, by { ext, dsimp, simp only [category.comp_id, category.id_comp], })

/--
Cones over `diagram U ⋙ F` are the same as a cones over the usual sheaf condition equalizer diagram.
-/
@[simps]
def cone_equiv (F : presheaf C X) ⦃ι : Type v⦄ (U : ι → opens X) :
  limits.cone ((diagram U).op ⋙ F) ≌ limits.cone (sheaf_condition_equalizer_products.diagram F U) :=
{ functor := cone_equiv_functor F U,
  inverse := cone_equiv_inverse F U,
  unit_iso := cone_equiv_unit_iso F U,
  counit_iso := cone_equiv_counit_iso F U, }

local attribute [reducible]
  sheaf_condition_equalizer_products.res
  sheaf_condition_equalizer_products.left_res

/--
If `sheaf_condition_equalizer_products.fork` is an equalizer,
then `F.map_cone (cone U)` is a limit cone.
-/
def is_limit_map_cone_of_is_limit_sheaf_condition_fork
  (F : presheaf C X) ⦃ι : Type v⦄ (U : ι → opens X)
  (P : is_limit (sheaf_condition_equalizer_products.fork F U)) :
  is_limit (F.map_cone (cocone U).op) :=
is_limit.of_iso_limit ((is_limit.of_cone_equiv (cone_equiv F U).symm).symm P)
{ hom :=
  { hom := 𝟙 _,
    w' :=
    begin
      intro x,
      induction x using opposite.rec,
      rcases x with ⟨⟩,
      { dsimp, simp, refl, },
      { dsimp,
        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
          category.assoc],
        rw ←F.map_comp,
        refl, }
    end },
  inv :=
  { hom := 𝟙 _,
    w' :=
    begin
      intro x,
      induction x using opposite.rec,
      rcases x with ⟨⟩,
      { dsimp, simp, refl, },
      { dsimp,
        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
          category.assoc],
        rw ←F.map_comp,
        refl, }
    end },
  hom_inv_id' := by { ext, dsimp, simp only [category.comp_id], },
  inv_hom_id' := by { ext, dsimp, simp only [category.comp_id], }, }

/--
If `F.map_cone (cone U)` is a limit cone,
then `sheaf_condition_equalizer_products.fork` is an equalizer.
-/
def is_limit_sheaf_condition_fork_of_is_limit_map_cone
  (F : presheaf C X) ⦃ι : Type v⦄ (U : ι → opens X)
  (Q : is_limit (F.map_cone (cocone U).op)) :
  is_limit (sheaf_condition_equalizer_products.fork F U) :=
is_limit.of_iso_limit ((is_limit.of_cone_equiv (cone_equiv F U)).symm Q)
{ hom :=
  { hom := 𝟙 _,
    w' :=
    begin
      rintro ⟨⟩,
      { dsimp, simp, refl, },
      { dsimp, ext ⟨i, j⟩,
        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
          category.assoc],
        rw ←F.map_comp,
        refl, }
    end },
  inv :=
  { hom := 𝟙 _,
    w' :=
    begin
      rintro ⟨⟩,
      { dsimp, simp, refl, },
      { dsimp, ext ⟨i, j⟩,
        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
          category.assoc],
        rw ←F.map_comp,
        refl, }
    end },
  hom_inv_id' := by { ext, dsimp, simp only [category.comp_id], },
  inv_hom_id' := by { ext, dsimp, simp only [category.comp_id], }, }

end sheaf_condition_pairwise_intersections

open sheaf_condition_pairwise_intersections

/--
The sheaf condition in terms of an equalizer diagram is equivalent
to the reformulation in terms of a limit diagram over `U i` and `U i ⊓ U j`.
-/
lemma is_sheaf_iff_is_sheaf_pairwise_intersections (F : presheaf C X) :
  F.is_sheaf ↔ F.is_sheaf_pairwise_intersections :=
iff.intro (λ h ι U, ⟨is_limit_map_cone_of_is_limit_sheaf_condition_fork F U (h U).some⟩)
  (λ h ι U, ⟨is_limit_sheaf_condition_fork_of_is_limit_map_cone F U (h U).some⟩)

/--
The sheaf condition in terms of an equalizer diagram is equivalent
to the reformulation in terms of the presheaf preserving the limit of the diagram
consisting of the `U i` and `U i ⊓ U j`.
-/
lemma is_sheaf_iff_is_sheaf_preserves_limit_pairwise_intersections (F : presheaf C X) :
  F.is_sheaf ↔ F.is_sheaf_preserves_limit_pairwise_intersections :=
begin
  rw is_sheaf_iff_is_sheaf_pairwise_intersections,
  split,
  { intros h ι U,
    exact ⟨preserves_limit_of_preserves_limit_cone (pairwise.cocone_is_colimit U).op (h U).some⟩ },
  { intros h ι U,
    haveI := (h U).some,
    exact ⟨preserves_limit.preserves (pairwise.cocone_is_colimit U).op⟩ }
end

end Top.presheaf


/-
Copyright (c) 2021 Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Junyan Xu
-/

import topology.sheaves.sheaf_condition.pairwise_intersections

/-!
# functors between categories of sheaves

Show that the pushforward of a sheaf is a sheaf, and define
the pushforward functor from the category of C-valued sheaves
on X to that of sheaves on Y, given a continuous map between
topological spaces X and Y.

TODO: pullback for presheaves and sheaves
-/

noncomputable theory

universes v u u₁

open category_theory
open category_theory.limits
open topological_space

variables {C : Type u₁} [category.{v} C]
variables {X Y : Top.{v}} (f : X ⟶ Y)
variables ⦃ι : Type v⦄ {U : ι → opens Y}

namespace Top
namespace presheaf.sheaf_condition_pairwise_intersections

lemma map_diagram :
  pairwise.diagram U ⋙ opens.map f = pairwise.diagram ((opens.map f).obj ∘ U) :=
begin
  apply functor.hext,
  abstract obj_eq {intro i, cases i; refl},
  intros i j g, apply subsingleton.helim,
  iterate 2 {rw map_diagram.obj_eq},
end

lemma map_cocone : (opens.map f).map_cocone (pairwise.cocone U)
                     == pairwise.cocone ((opens.map f).obj ∘ U) :=
begin
  unfold functor.map_cocone cocones.functoriality, dsimp, congr,
  iterate 2 {rw map_diagram, rw opens.map_supr},
  apply subsingleton.helim, rw [map_diagram, opens.map_supr],
  apply proof_irrel_heq,
end

theorem pushforward_sheaf_of_sheaf {F : presheaf C X}
  (h : F.is_sheaf_pairwise_intersections) :
  (f _* F).is_sheaf_pairwise_intersections :=
λ ι U, begin
  convert h ((opens.map f).obj ∘ U) using 2,
  rw ← map_diagram, refl,
  change F.map_cone ((opens.map f).map_cocone _).op == _,
  congr, iterate 2 {rw map_diagram}, apply map_cocone,
end

end presheaf.sheaf_condition_pairwise_intersections

namespace sheaf

open presheaf

variables [has_products C]

/--
The pushforward of a sheaf (by a continuous map) is a sheaf.
-/
theorem pushforward_sheaf_of_sheaf
  {F : presheaf C X} (h : F.is_sheaf) : (f _* F).is_sheaf :=
by rw is_sheaf_iff_is_sheaf_pairwise_intersections at h ⊢;
   exact sheaf_condition_pairwise_intersections.pushforward_sheaf_of_sheaf f h

/--
The pushforward functor.
-/
def pushforward (f : X ⟶ Y) : X.sheaf C ⥤ Y.sheaf C :=
{ obj := λ ℱ, ⟨f _* ℱ.1, pushforward_sheaf_of_sheaf f ℱ.2⟩,
  map := λ _ _, pushforward_map f }

end sheaf

end Top


namespace fol_18

variable U : Type
variables P Q : U → Prop
variable c : U

theorem fol_18 (h : ∃ x, P x ∧ Q x ∧ ∀ y, P y → x = y) : P c → Q c :=
assume h1: P c,
have h2: P c ∧ Q c ∧ ∀ y, P y → c = y, from exists.elim h
  (assume s (h3: P s ∧ Q s ∧ ∀ y, P y → s = y),
   have h4: _, from and.right h3,
   have h5: _, from and.right h4,
   have h6: P c → s = c, from h5 c,
   have h7: s = c, from h6 h1,
   have h8: c = s, from eq.symm h7,
   begin
     rw h8,
     from h3
   end),
show Q c, from and.left (and.right h2)

end fol_18


import tactic.suggest
import lib.attempt
import logic.function
import tactic.interactive

namespace algorithms

structure array (α : Type) := (size : nat) (get : fin size → α)

namespace array

def index {α : Type} (a : array α) := fin a.size

def set {α} (a : array α) (i : a.index) (v : α) : array α :=
mk a.size $ λ j, if j = i then v else a.get j

lemma empty_eq_empty (a b : array nat) (h: a.size = 0) (g : b.size = 0) : a = b :=
begin
  cases a, cases b,
  cases h, cases g,
  rw array.mk.inj_eq,
  split,
  { refl },
  { apply function.hfunext rfl,
    intros a,
    exact fin.elim0 a }
end

lemma set_set_eq_set {α} {a : array α} {x y : α} {i : a.index} : set (set a i y) i x = set a i x :=
begin
  unfold set,
  rw array.mk.inj_eq,
  split,
  { refl },
  { apply function.hfunext rfl,
    intros b c h,
    rw eq_of_heq h,
    by_cases he : c = i,
    { rw if_pos he, rw if_pos he },
    { rw if_neg he, rw if_neg he,
      dunfold array.set at *,
      simp [he] } }
end

end array

end algorithms


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

! This file was ported from Lean 3 source module category_theory.sites.dense_subsite
! leanprover-community/mathlib commit 14b69e9f3c16630440a2cbd46f1ddad0d561dee7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Sites.Sheaf
import Mathbin.CategoryTheory.Sites.CoverLifting
import Mathbin.CategoryTheory.Adjunction.FullyFaithful

/-!
# Dense subsites

We define `cover_dense` functors into sites as functors such that there exists a covering sieve
that factors through images of the functor for each object in `D`.

We will primarily consider cover-dense functors that are also full, since this notion is in general
not well-behaved otherwise. Note that https://ncatlab.org/nlab/show/dense+sub-site indeed has a
weaker notion of cover-dense that loosens this requirement, but it would not have all the properties
we would need, and some sheafification would be needed for here and there.

## Main results

- `category_theory.cover_dense.presheaf_hom`: If `G : C ⥤ (D, K)` is full and cover-dense,
  then given any presheaf `ℱ` and sheaf `ℱ'` on `D`, and a morphism `α : G ⋙ ℱ ⟶ G ⋙ ℱ'`,
  we may glue them together to obtain a morphism of presheaves `ℱ ⟶ ℱ'`.
- `category_theory.cover_dense.sheaf_iso`: If `ℱ` above is a sheaf and `α` is an iso,
  then the result is also an iso.
- `category_theory.cover_dense.iso_of_restrict_iso`: If `G : C ⥤ (D, K)` is full and cover-dense,
  then given any sheaves `ℱ, ℱ'` on `D`, and a morphism `α : ℱ ⟶ ℱ'`, then `α` is an iso if
  `G ⋙ ℱ ⟶ G ⋙ ℱ'` is iso.
- `category_theory.cover_dense.Sheaf_equiv_of_cover_preserving_cover_lifting`:
  If `G : (C, J) ⥤ (D, K)` is fully-faithful, cover-lifting, cover-preserving, and cover-dense,
  then it will induce an equivalence of categories of sheaves valued in a complete category.

## References

* [Elephant]: *Sketches of an Elephant*, ℱ. T. Johnstone: C2.2.
* https://ncatlab.org/nlab/show/dense+sub-site
* https://ncatlab.org/nlab/show/comparison+lemma

-/

universe w v u

namespace CategoryTheory

variable {C : Type _} [Category C] {D : Type _} [Category D] {E : Type _} [Category E]

variable (J : GrothendieckTopology C) (K : GrothendieckTopology D)

variable {L : GrothendieckTopology E}

/-- An auxiliary structure that witnesses the fact that `f` factors through an image object of `G`.
-/
@[nolint has_nonempty_instance]
structure Presieve.CoverByImageStructure (G : C ⥤ D) {V U : D} (f : V ⟶ U) where
  obj : C
  lift : V ⟶ G.obj obj
  map : G.obj obj ⟶ U
  fac : lift ≫ map = f := by obviously
#align category_theory.presieve.cover_by_image_structure CategoryTheory.Presieve.CoverByImageStructure

restate_axiom presieve.cover_by_image_structure.fac'

attribute [simp, reassoc.1] presieve.cover_by_image_structure.fac

/-- For a functor `G : C ⥤ D`, and an object `U : D`, `presieve.cover_by_image G U` is the presieve
of `U` consisting of those arrows that factor through images of `G`.
-/
def Presieve.coverByImage (G : C ⥤ D) (U : D) : Presieve U := fun Y f =>
  Nonempty (Presieve.CoverByImageStructure G f)
#align category_theory.presieve.cover_by_image CategoryTheory.Presieve.coverByImage

/-- For a functor `G : C ⥤ D`, and an object `U : D`, `sieve.cover_by_image G U` is the sieve of `U`
consisting of those arrows that factor through images of `G`.
-/
def Sieve.coverByImage (G : C ⥤ D) (U : D) : Sieve U :=
  ⟨Presieve.coverByImage G U, fun X Y f ⟨⟨Z, f₁, f₂, (e : _ = _)⟩⟩ g =>
    ⟨⟨Z, g ≫ f₁, f₂, show (g ≫ f₁) ≫ f₂ = g ≫ f by rw [category.assoc, ← e]⟩⟩⟩
#align category_theory.sieve.cover_by_image CategoryTheory.Sieve.coverByImage

theorem Presieve.in_coverByImage (G : C ⥤ D) {X : D} {Y : C} (f : G.obj Y ⟶ X) :
    Presieve.coverByImage G X f :=
  ⟨⟨Y, 𝟙 _, f, by simp⟩⟩
#align category_theory.presieve.in_cover_by_image CategoryTheory.Presieve.in_coverByImage

/-- A functor `G : (C, J) ⥤ (D, K)` is called `cover_dense` if for each object in `D`,
  there exists a covering sieve in `D` that factors through images of `G`.

This definition can be found in https://ncatlab.org/nlab/show/dense+sub-site Definition 2.2.
-/
structure CoverDense (K : GrothendieckTopology D) (G : C ⥤ D) : Prop where
  is_cover : ∀ U : D, Sieve.coverByImage G U ∈ K U
#align category_theory.cover_dense CategoryTheory.CoverDense

open Presieve Opposite

namespace CoverDense

variable {K}

variable {A : Type _} [Category A] {G : C ⥤ D} (H : CoverDense K G)

-- this is not marked with `@[ext]` because `H` can not be inferred from the type
theorem ext (H : CoverDense K G) (ℱ : SheafOfTypes K) (X : D) {s t : ℱ.val.obj (op X)}
    (h : ∀ ⦃Y : C⦄ (f : G.obj Y ⟶ X), ℱ.val.map f.op s = ℱ.val.map f.op t) : s = t :=
  by
  apply (ℱ.cond (sieve.cover_by_image G X) (H.is_cover X)).IsSeparatedFor.ext
  rintro Y _ ⟨Z, f₁, f₂, ⟨rfl⟩⟩
  simp [h f₂]
#align category_theory.cover_dense.ext CategoryTheory.CoverDense.ext

theorem functorPullback_pushforward_covering [Full G] (H : CoverDense K G) {X : C}
    (T : K (G.obj X)) : (T.val.functorPullback G).functorPushforward G ∈ K (G.obj X) :=
  by
  refine' K.superset_covering _ (K.bind_covering T.property fun Y f Hf => H.is_cover Y)
  rintro Y _ ⟨Z, _, f, hf, ⟨W, g, f', ⟨rfl⟩⟩, rfl⟩
  use W; use G.preimage (f' ≫ f); use g
  constructor
  · simpa using T.val.downward_closed hf f'
  · simp
#align category_theory.cover_dense.functor_pullback_pushforward_covering CategoryTheory.CoverDense.functorPullback_pushforward_covering

/-- (Implementation). Given an hom between the pullbacks of two sheaves, we can whisker it with
`coyoneda` to obtain an hom between the pullbacks of the sheaves of maps from `X`.
-/
@[simps]
def homOver {ℱ : Dᵒᵖ ⥤ A} {ℱ' : Sheaf K A} (α : G.op ⋙ ℱ ⟶ G.op ⋙ ℱ'.val) (X : A) :
    G.op ⋙ ℱ ⋙ coyoneda.obj (op X) ⟶ G.op ⋙ (sheafOver ℱ' X).val :=
  whiskerRight α (coyoneda.obj (op X))
#align category_theory.cover_dense.hom_over CategoryTheory.CoverDense.homOver

/-- (Implementation). Given an iso between the pullbacks of two sheaves, we can whisker it with
`coyoneda` to obtain an iso between the pullbacks of the sheaves of maps from `X`.
-/
@[simps]
def isoOver {ℱ ℱ' : Sheaf K A} (α : G.op ⋙ ℱ.val ≅ G.op ⋙ ℱ'.val) (X : A) :
    G.op ⋙ (sheafOver ℱ X).val ≅ G.op ⋙ (sheafOver ℱ' X).val :=
  isoWhiskerRight α (coyoneda.obj (op X))
#align category_theory.cover_dense.iso_over CategoryTheory.CoverDense.isoOver

theorem sheaf_eq_amalgamation (ℱ : Sheaf K A) {X : A} {U : D} {T : Sieve U} (hT)
    (x : FamilyOfElements _ T) (hx) (t) (h : x.IsAmalgamation t) :
    t = (ℱ.cond X T hT).amalgamate x hx :=
  (ℱ.cond X T hT).IsSeparatedFor x t _ h ((ℱ.cond X T hT).IsAmalgamation hx)
#align category_theory.cover_dense.sheaf_eq_amalgamation CategoryTheory.CoverDense.sheaf_eq_amalgamation

include H

variable [Full G]

namespace Types

variable {ℱ : Dᵒᵖ ⥤ Type v} {ℱ' : SheafOfTypes.{v} K} (α : G.op ⋙ ℱ ⟶ G.op ⋙ ℱ'.val)

/--
(Implementation). Given a section of `ℱ` on `X`, we can obtain a family of elements valued in `ℱ'`
that is defined on a cover generated by the images of `G`. -/
@[simp, nolint unused_arguments]
noncomputable def pushforwardFamily {X} (x : ℱ.obj (op X)) :
    FamilyOfElements ℱ'.val (coverByImage G X) := fun Y f hf =>
  ℱ'.val.map hf.some.lift.op <| α.app (op _) (ℱ.map hf.some.map.op x : _)
#align category_theory.cover_dense.types.pushforward_family CategoryTheory.CoverDense.Types.pushforwardFamily

/-- (Implementation). The `pushforward_family` defined is compatible. -/
theorem pushforwardFamily_compatible {X} (x : ℱ.obj (op X)) :
    (pushforwardFamily H α x).Compatible :=
  by
  intro Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ e
  apply H.ext
  intro Y f
  simp only [pushforward_family, ← functor_to_types.map_comp_apply, ← op_comp]
  change (ℱ.map _ ≫ α.app (op _) ≫ ℱ'.val.map _) _ = (ℱ.map _ ≫ α.app (op _) ≫ ℱ'.val.map _) _
  rw [← G.image_preimage (f ≫ g₁ ≫ _)]
  rw [← G.image_preimage (f ≫ g₂ ≫ _)]
  erw [← α.naturality (G.preimage _).op]
  erw [← α.naturality (G.preimage _).op]
  refine' congr_fun _ x
  simp only [Quiver.Hom.unop_op, functor.comp_map, ← op_comp, ← category.assoc, functor.op_map, ←
    ℱ.map_comp, G.image_preimage]
  congr 3
  simp [e]
#align category_theory.cover_dense.types.pushforward_family_compatible CategoryTheory.CoverDense.Types.pushforwardFamily_compatible

/-- (Implementation). The morphism `ℱ(X) ⟶ ℱ'(X)` given by gluing the `pushforward_family`. -/
noncomputable def appHom (X : D) : ℱ.obj (op X) ⟶ ℱ'.val.obj (op X) := fun x =>
  (ℱ'.cond _ (H.is_cover X)).amalgamate (pushforwardFamily H α x)
    (pushforwardFamily_compatible H α x)
#align category_theory.cover_dense.types.app_hom CategoryTheory.CoverDense.Types.appHom

@[simp]
theorem pushforwardFamily_apply {X} (x : ℱ.obj (op X)) {Y : C} (f : G.obj Y ⟶ X) :
    pushforwardFamily H α x f (Presieve.in_coverByImage G f) = α.app (op Y) (ℱ.map f.op x) :=
  by
  unfold pushforward_family
  refine' congr_fun _ x
  rw [← G.image_preimage (Nonempty.some _ : presieve.cover_by_image_structure _ _).lift]
  change ℱ.map _ ≫ α.app (op _) ≫ ℱ'.val.map _ = ℱ.map f.op ≫ α.app (op Y)
  erw [← α.naturality (G.preimage _).op]
  simp only [← functor.map_comp, ← category.assoc, functor.comp_map, G.image_preimage, G.op_map,
    Quiver.Hom.unop_op, ← op_comp, presieve.cover_by_image_structure.fac]
#align category_theory.cover_dense.types.pushforward_family_apply CategoryTheory.CoverDense.Types.pushforwardFamily_apply

@[simp]
theorem appHom_restrict {X : D} {Y : C} (f : op X ⟶ op (G.obj Y)) (x) :
    ℱ'.val.map f (appHom H α X x) = α.app (op Y) (ℱ.map f x) :=
  by
  refine'
    ((ℱ'.cond _ (H.is_cover X)).valid_glue (pushforward_family_compatible H α x) f.unop
          (presieve.in_cover_by_image G f.unop)).trans
      _
  apply pushforward_family_apply
#align category_theory.cover_dense.types.app_hom_restrict CategoryTheory.CoverDense.Types.appHom_restrict

@[simp]
theorem appHom_valid_glue {X : D} {Y : C} (f : op X ⟶ op (G.obj Y)) :
    appHom H α X ≫ ℱ'.val.map f = ℱ.map f ≫ α.app (op Y) :=
  by
  ext
  apply app_hom_restrict
#align category_theory.cover_dense.types.app_hom_valid_glue CategoryTheory.CoverDense.Types.appHom_valid_glue

/--
(Implementation). The maps given in `app_iso` is inverse to each other and gives a `ℱ(X) ≅ ℱ'(X)`.
-/
@[simps]
noncomputable def appIso {ℱ ℱ' : SheafOfTypes.{v} K} (i : G.op ⋙ ℱ.val ≅ G.op ⋙ ℱ'.val) (X : D) :
    ℱ.val.obj (op X) ≅ ℱ'.val.obj (op X)
    where
  Hom := appHom H i.Hom X
  inv := appHom H i.inv X
  hom_inv_id' := by
    ext x
    apply H.ext
    intro Y f
    simp
  inv_hom_id' := by
    ext x
    apply H.ext
    intro Y f
    simp
#align category_theory.cover_dense.types.app_iso CategoryTheory.CoverDense.Types.appIso

/-- Given an natural transformation `G ⋙ ℱ ⟶ G ⋙ ℱ'` between presheaves of types, where `G` is full
and cover-dense, and `ℱ'` is a sheaf, we may obtain a natural transformation between sheaves.
-/
@[simps]
noncomputable def presheafHom (α : G.op ⋙ ℱ ⟶ G.op ⋙ ℱ'.val) : ℱ ⟶ ℱ'.val
    where
  app X := appHom H α (unop X)
  naturality' X Y f := by
    ext x
    apply H.ext ℱ' (unop Y)
    intro Y' f'
    simp only [app_hom_restrict, types_comp_apply, ← functor_to_types.map_comp_apply]
    rw [app_hom_restrict H α (f ≫ f'.op : op (unop X) ⟶ _)]
#align category_theory.cover_dense.types.presheaf_hom CategoryTheory.CoverDense.Types.presheafHom

/-- Given an natural isomorphism `G ⋙ ℱ ≅ G ⋙ ℱ'` between presheaves of types, where `G` is full and
cover-dense, and `ℱ, ℱ'` are sheaves, we may obtain a natural isomorphism between presheaves.
-/
@[simps]
noncomputable def presheafIso {ℱ ℱ' : SheafOfTypes.{v} K} (i : G.op ⋙ ℱ.val ≅ G.op ⋙ ℱ'.val) :
    ℱ.val ≅ ℱ'.val :=
  NatIso.ofComponents (fun X => appIso H i (unop X)) (presheafHom H i.Hom).naturality
#align category_theory.cover_dense.types.presheaf_iso CategoryTheory.CoverDense.Types.presheafIso

/-- Given an natural isomorphism `G ⋙ ℱ ≅ G ⋙ ℱ'` between presheaves of types, where `G` is full and
cover-dense, and `ℱ, ℱ'` are sheaves, we may obtain a natural isomorphism between sheaves.
-/
@[simps]
noncomputable def sheafIso {ℱ ℱ' : SheafOfTypes.{v} K} (i : G.op ⋙ ℱ.val ≅ G.op ⋙ ℱ'.val) : ℱ ≅ ℱ'
    where
  Hom := ⟨(presheafIso H i).Hom⟩
  inv := ⟨(presheafIso H i).inv⟩
  hom_inv_id' := by
    ext1
    apply (presheaf_iso H i).hom_inv_id
  inv_hom_id' := by
    ext1
    apply (presheaf_iso H i).inv_hom_id
#align category_theory.cover_dense.types.sheaf_iso CategoryTheory.CoverDense.Types.sheafIso

end Types

open Types

variable {ℱ : Dᵒᵖ ⥤ A} {ℱ' : Sheaf K A}

/-- (Implementation). The sheaf map given in `types.sheaf_hom` is natural in terms of `X`. -/
@[simps]
noncomputable def sheafCoyonedaHom (α : G.op ⋙ ℱ ⟶ G.op ⋙ ℱ'.val) :
    coyoneda ⋙ (whiskeringLeft Dᵒᵖ A (Type _)).obj ℱ ⟶
      coyoneda ⋙ (whiskeringLeft Dᵒᵖ A (Type _)).obj ℱ'.val
    where
  app X := presheafHom H (homOver α (unop X))
  naturality' X Y f := by
    ext (U x)
    change
      app_hom H (hom_over α (unop Y)) (unop U) (f.unop ≫ x) =
        f.unop ≫ app_hom H (hom_over α (unop X)) (unop U) x
    symm
    apply sheaf_eq_amalgamation
    apply H.is_cover
    intro Y' f' hf'
    change unop X ⟶ ℱ.obj (op (unop _)) at x
    dsimp
    simp only [pushforward_family, functor.comp_map, coyoneda_obj_map, hom_over_app, category.assoc]
    congr 1
    conv_lhs => rw [← hf'.some.fac]
    simp only [← category.assoc, op_comp, functor.map_comp]
    congr 1
    refine' (app_hom_restrict H (hom_over α (unop X)) hf'.some.map.op x).trans _
    simp
#align category_theory.cover_dense.sheaf_coyoneda_hom CategoryTheory.CoverDense.sheafCoyonedaHom

/--
(Implementation). `sheaf_coyoneda_hom` but the order of the arguments of the functor are swapped.
-/
noncomputable def sheafYonedaHom (α : G.op ⋙ ℱ ⟶ G.op ⋙ ℱ'.val) : ℱ ⋙ yoneda ⟶ ℱ'.val ⋙ yoneda :=
  by
  let α := sheaf_coyoneda_hom H α
  refine'
    { app := _
      naturality' := _ }
  · intro U
    refine'
      { app := fun X => (α.app X).app U
        naturality' := fun X Y f => by simpa using congr_app (α.naturality f) U }
  · intro U V i
    ext (X x)
    exact congr_fun ((α.app X).naturality i) x
#align category_theory.cover_dense.sheaf_yoneda_hom CategoryTheory.CoverDense.sheafYonedaHom

/-- Given an natural transformation `G ⋙ ℱ ⟶ G ⋙ ℱ'` between presheaves of arbitrary category,
where `G` is full and cover-dense, and `ℱ'` is a sheaf, we may obtain a natural transformation
between presheaves.
-/
noncomputable def sheafHom (α : G.op ⋙ ℱ ⟶ G.op ⋙ ℱ'.val) : ℱ ⟶ ℱ'.val :=
  let α' := sheafYonedaHom H α
  { app := fun X => yoneda.preimage (α'.app X)
    naturality' := fun X Y f => yoneda.map_injective (by simpa using α'.naturality f) }
#align category_theory.cover_dense.sheaf_hom CategoryTheory.CoverDense.sheafHom

/-- Given an natural isomorphism `G ⋙ ℱ ≅ G ⋙ ℱ'` between presheaves of arbitrary category,
where `G` is full and cover-dense, and `ℱ', ℱ` are sheaves,
we may obtain a natural isomorphism between presheaves.
-/
@[simps]
noncomputable def presheafIso {ℱ ℱ' : Sheaf K A} (i : G.op ⋙ ℱ.val ≅ G.op ⋙ ℱ'.val) :
    ℱ.val ≅ ℱ'.val :=
  by
  have : ∀ X : Dᵒᵖ, is_iso ((sheaf_hom H i.hom).app X) :=
    by
    intro X
    apply is_iso_of_reflects_iso _ yoneda
    use (sheaf_yoneda_hom H i.inv).app X
    constructor <;> ext x : 2 <;>
      simp only [sheaf_hom, nat_trans.comp_app, nat_trans.id_app, functor.image_preimage]
    exact ((presheaf_iso H (iso_over i (unop x))).app X).hom_inv_id
    exact ((presheaf_iso H (iso_over i (unop x))).app X).inv_hom_id
    infer_instance
  haveI : is_iso (sheaf_hom H i.hom) := by apply nat_iso.is_iso_of_is_iso_app
  apply as_iso (sheaf_hom H i.hom)
#align category_theory.cover_dense.presheaf_iso CategoryTheory.CoverDense.presheafIso

/-- Given an natural isomorphism `G ⋙ ℱ ≅ G ⋙ ℱ'` between presheaves of arbitrary category,
where `G` is full and cover-dense, and `ℱ', ℱ` are sheaves,
we may obtain a natural isomorphism between presheaves.
-/
@[simps]
noncomputable def sheafIso {ℱ ℱ' : Sheaf K A} (i : G.op ⋙ ℱ.val ≅ G.op ⋙ ℱ'.val) : ℱ ≅ ℱ'
    where
  Hom := ⟨(presheafIso H i).Hom⟩
  inv := ⟨(presheafIso H i).inv⟩
  hom_inv_id' := by
    ext1
    apply (presheaf_iso H i).hom_inv_id
  inv_hom_id' := by
    ext1
    apply (presheaf_iso H i).inv_hom_id
#align category_theory.cover_dense.sheaf_iso CategoryTheory.CoverDense.sheafIso

/-- The constructed `sheaf_hom α` is equal to `α` when restricted onto `C`.
-/
theorem sheafHom_restrict_eq (α : G.op ⋙ ℱ ⟶ G.op ⋙ ℱ'.val) : whiskerLeft G.op (sheafHom H α) = α :=
  by
  ext X
  apply yoneda.map_injective
  ext U
  erw [yoneda.image_preimage]
  symm
  change (show (ℱ'.val ⋙ coyoneda.obj (op (unop U))).obj (op (G.obj (unop X))) from _) = _
  apply sheaf_eq_amalgamation ℱ' (H.is_cover _)
  intro Y f hf
  conv_lhs => rw [← hf.some.fac]
  simp only [pushforward_family, functor.comp_map, yoneda_map_app, coyoneda_obj_map, op_comp,
    functor_to_types.map_comp_apply, hom_over_app, ← category.assoc]
  congr 1
  simp only [category.assoc]
  congr 1
  rw [← G.image_preimage hf.some.map]
  symm
  apply α.naturality (G.preimage hf.some.map).op
  infer_instance
#align category_theory.cover_dense.sheaf_hom_restrict_eq CategoryTheory.CoverDense.sheafHom_restrict_eq

/-- If the pullback map is obtained via whiskering,
then the result `sheaf_hom (whisker_left G.op α)` is equal to `α`.
-/
theorem sheafHom_eq (α : ℱ ⟶ ℱ'.val) : sheafHom H (whiskerLeft G.op α) = α :=
  by
  ext X
  apply yoneda.map_injective
  swap; · infer_instance
  ext U
  erw [yoneda.image_preimage]
  symm
  change (show (ℱ'.val ⋙ coyoneda.obj (op (unop U))).obj (op (unop X)) from _) = _
  apply sheaf_eq_amalgamation ℱ' (H.is_cover _)
  intro Y f hf
  conv_lhs => rw [← hf.some.fac]
  dsimp
  simp
#align category_theory.cover_dense.sheaf_hom_eq CategoryTheory.CoverDense.sheafHom_eq

/-- A full and cover-dense functor `G` induces an equivalence between morphisms into a sheaf and
morphisms over the restrictions via `G`.
-/
noncomputable def restrictHomEquivHom : (G.op ⋙ ℱ ⟶ G.op ⋙ ℱ'.val) ≃ (ℱ ⟶ ℱ'.val)
    where
  toFun := sheafHom H
  invFun := whiskerLeft G.op
  left_inv := sheafHom_restrict_eq H
  right_inv := sheafHom_eq H
#align category_theory.cover_dense.restrict_hom_equiv_hom CategoryTheory.CoverDense.restrictHomEquivHom

/-- Given a full and cover-dense functor `G` and a natural transformation of sheaves `α : ℱ ⟶ ℱ'`,
if the pullback of `α` along `G` is iso, then `α` is also iso.
-/
theorem iso_of_restrict_iso {ℱ ℱ' : Sheaf K A} (α : ℱ ⟶ ℱ') (i : IsIso (whiskerLeft G.op α.val)) :
    IsIso α :=
  by
  convert is_iso.of_iso (sheaf_iso H (as_iso (whisker_left G.op α.val))) using 1
  ext1
  apply (sheaf_hom_eq _ _).symm
#align category_theory.cover_dense.iso_of_restrict_iso CategoryTheory.CoverDense.iso_of_restrict_iso

/-- A fully faithful cover-dense functor preserves compatible families. -/
theorem compatiblePreserving [Faithful G] : CompatiblePreserving K G :=
  by
  constructor
  intro ℱ Z T x hx Y₁ Y₂ X f₁ f₂ g₁ g₂ hg₁ hg₂ eq
  apply H.ext
  intro W i
  simp only [← functor_to_types.map_comp_apply, ← op_comp]
  rw [← G.image_preimage (i ≫ f₁)]
  rw [← G.image_preimage (i ≫ f₂)]
  apply hx
  apply G.map_injective
  simp [Eq]
#align category_theory.cover_dense.compatible_preserving CategoryTheory.CoverDense.compatiblePreserving

noncomputable instance Sites.Pullback.full [Faithful G] (Hp : CoverPreserving J K G) :
    Full (Sites.pullback A H.CompatiblePreserving Hp)
    where
  preimage ℱ ℱ' α := ⟨H.sheafHom α.val⟩
  witness' ℱ ℱ' α := Sheaf.Hom.ext _ _ <| H.sheafHom_restrict_eq α.val
#align category_theory.cover_dense.sites.pullback.full CategoryTheory.CoverDense.Sites.Pullback.full

instance Sites.Pullback.faithful [Faithful G] (Hp : CoverPreserving J K G) :
    Faithful (Sites.pullback A H.CompatiblePreserving Hp)
    where map_injective' := by
    intro ℱ ℱ' α β e
    ext1
    apply_fun fun e => e.val  at e
    dsimp at e
    rw [← H.sheaf_hom_eq α.val, ← H.sheaf_hom_eq β.val, e]
#align category_theory.cover_dense.sites.pullback.faithful CategoryTheory.CoverDense.Sites.Pullback.faithful

end CoverDense

end CategoryTheory

namespace CategoryTheory.CoverDense

open CategoryTheory

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

variable {G : C ⥤ D} [Full G] [Faithful G]

variable {J : GrothendieckTopology C} {K : GrothendieckTopology D}

variable {A : Type w} [Category.{max u v} A] [Limits.HasLimits A]

variable (Hd : CoverDense K G) (Hp : CoverPreserving J K G) (Hl : CoverLifting J K G)

include Hd Hp Hl

/-- Given a functor between small sites that is cover-dense, cover-preserving, and cover-lifting,
it induces an equivalence of category of sheaves valued in a complete category.
-/
@[simps Functor inverse]
noncomputable def sheafEquivOfCoverPreservingCoverLifting : Sheaf J A ≌ Sheaf K A :=
  by
  symm
  let α := Sites.pullbackCopullbackAdjunction.{w, v, u} A Hp Hl Hd.compatible_preserving
  have : ∀ X : Sheaf J A, is_iso (α.counit.app X) :=
    by
    intro ℱ
    apply (config := { instances := false }) reflects_isomorphisms.reflects (Sheaf_to_presheaf J A)
    exact is_iso.of_iso ((@as_iso _ _ _ _ _ (Ran.reflective A G.op)).app ℱ.val)
  haveI : is_iso α.counit := nat_iso.is_iso_of_is_iso_app _
  exact
    { Functor := sites.pullback A Hd.compatible_preserving Hp
      inverse := sites.copullback A Hl
      unitIso := as_iso α.unit
      counitIso := as_iso α.counit
      functor_unitIso_comp' := fun ℱ => by convert α.left_triangle_components }
#align category_theory.cover_dense.Sheaf_equiv_of_cover_preserving_cover_lifting CategoryTheory.CoverDense.sheafEquivOfCoverPreservingCoverLifting

end CategoryTheory.CoverDense


example (A B C D E F G H I J K L : Type)
(f1 : A → B) (f2 : B → E) (f3 : E → D) (f4 : D → A) (f5 : E → F)
(f6 : F → C) (f7 : B → C) (f8 : F → G) (f9 : G → J) (f10 : I → J)
(f11 : J → I) (f12 : I → H) (f13 : E → H) (f14 : H → K) (f15 : I → L)
 : A → L :=
begin
intro a,
exact f15 (f11 (f9 (f8 (f5 (f2 (f1 a)))))),

end


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monoidal.braided
import Mathlib.category_theory.limits.shapes.binary_products
import Mathlib.category_theory.limits.shapes.terminal
import Mathlib.category_theory.pempty
import Mathlib.PostPort

universes v u

namespace Mathlib

/-!
# The monoidal structure on a category with chosen finite products.

This is a variant of the development in `category_theory.monoidal.of_has_finite_products`,
which uses specified choices of the terminal object and binary product,
enabling the construction of a cartesian category with specific definitions of the tensor unit
and tensor product.

(Because the construction in `category_theory.monoidal.of_has_finite_products` uses `has_limit`
classes, the actual definitions there are opaque behind `classical.choice`.)

We use this in `category_theory.monoidal.types` to construct the monoidal category of types
so that the tensor product is the usual cartesian product of types.

For now we only do the construction from products, and not from coproducts,
which seems less often useful.
-/

namespace category_theory

namespace limits

/-- Swap the two sides of a `binary_fan`. -/
def binary_fan.swap {C : Type u} [category C] {P : C} {Q : C} (t : binary_fan P Q) :
    binary_fan Q P :=
  binary_fan.mk (binary_fan.snd t) (binary_fan.fst t)

@[simp] theorem binary_fan.swap_fst {C : Type u} [category C] {P : C} {Q : C} (t : binary_fan P Q) :
    binary_fan.fst (binary_fan.swap t) = binary_fan.snd t :=
  rfl

@[simp] theorem binary_fan.swap_snd {C : Type u} [category C] {P : C} {Q : C} (t : binary_fan P Q) :
    binary_fan.snd (binary_fan.swap t) = binary_fan.fst t :=
  rfl

/--
If a cone `t` over `P Q` is a limit cone, then `t.swap` is a limit cone over `Q P`.
-/
@[simp] theorem is_limit.swap_binary_fan_lift {C : Type u} [category C] {P : C} {Q : C}
    {t : binary_fan P Q} (I : is_limit t) (s : cone (pair Q P)) :
    is_limit.lift (is_limit.swap_binary_fan I) s = is_limit.lift I (binary_fan.swap s) :=
  Eq.refl (is_limit.lift (is_limit.swap_binary_fan I) s)

/--
Construct `has_binary_product Q P` from `has_binary_product P Q`.
This can't be an instance, as it would cause a loop in typeclass search.
-/
theorem has_binary_product.swap {C : Type u} [category C] (P : C) (Q : C) [has_binary_product P Q] :
    has_binary_product Q P :=
  has_limit.mk
    (limit_cone.mk (binary_fan.swap (limit.cone (pair P Q)))
      (is_limit.swap_binary_fan (limit.is_limit (pair P Q))))

/--
Given a limit cone over `X` and `Y`, and another limit cone over `Y` and `X`, we can construct
an isomorphism between the cone points. Relative to some fixed choice of limits cones for every pair,
these isomorphisms constitute a braiding.
-/
def binary_fan.braiding {C : Type u} [category C] {X : C} {Y : C} {s : binary_fan X Y}
    (P : is_limit s) {t : binary_fan Y X} (Q : is_limit t) : cone.X s ≅ cone.X t :=
  is_limit.cone_point_unique_up_to_iso P (is_limit.swap_binary_fan Q)

/--
Given binary fans `sXY` over `X Y`, and `sYZ` over `Y Z`, and `s` over `sXY.X Z`,
if `sYZ` is a limit cone we can construct a binary fan over `X sYZ.X`.

This is an ingredient of building the associator for a cartesian category.
-/
def binary_fan.assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} {sXY : binary_fan X Y}
    {sYZ : binary_fan Y Z} (Q : is_limit sYZ) (s : binary_fan (cone.X sXY) Z) :
    binary_fan X (cone.X sYZ) :=
  binary_fan.mk (binary_fan.fst s ≫ binary_fan.fst sXY)
    (is_limit.lift Q (binary_fan.mk (binary_fan.fst s ≫ binary_fan.snd sXY) (binary_fan.snd s)))

@[simp] theorem binary_fan.assoc_fst {C : Type u} [category C] {X : C} {Y : C} {Z : C}
    {sXY : binary_fan X Y} {sYZ : binary_fan Y Z} (Q : is_limit sYZ)
    (s : binary_fan (cone.X sXY) Z) :
    binary_fan.fst (binary_fan.assoc Q s) = binary_fan.fst s ≫ binary_fan.fst sXY :=
  rfl

@[simp] theorem binary_fan.assoc_snd {C : Type u} [category C] {X : C} {Y : C} {Z : C}
    {sXY : binary_fan X Y} {sYZ : binary_fan Y Z} (Q : is_limit sYZ)
    (s : binary_fan (cone.X sXY) Z) :
    binary_fan.snd (binary_fan.assoc Q s) =
        is_limit.lift Q
          (binary_fan.mk (binary_fan.fst s ≫ binary_fan.snd sXY) (binary_fan.snd s)) :=
  rfl

/--
Given binary fans `sXY` over `X Y`, and `sYZ` over `Y Z`, and `s` over `X sYZ.X`,
if `sYZ` is a limit cone we can construct a binary fan over `sXY.X Z`.

This is an ingredient of building the associator for a cartesian category.
-/
def binary_fan.assoc_inv {C : Type u} [category C] {X : C} {Y : C} {Z : C} {sXY : binary_fan X Y}
    (P : is_limit sXY) {sYZ : binary_fan Y Z} (s : binary_fan X (cone.X sYZ)) :
    binary_fan (cone.X sXY) Z :=
  binary_fan.mk
    (is_limit.lift P (binary_fan.mk (binary_fan.fst s) (binary_fan.snd s ≫ binary_fan.fst sYZ)))
    (binary_fan.snd s ≫ binary_fan.snd sYZ)

@[simp] theorem binary_fan.assoc_inv_fst {C : Type u} [category C] {X : C} {Y : C} {Z : C}
    {sXY : binary_fan X Y} (P : is_limit sXY) {sYZ : binary_fan Y Z}
    (s : binary_fan X (cone.X sYZ)) :
    binary_fan.fst (binary_fan.assoc_inv P s) =
        is_limit.lift P
          (binary_fan.mk (binary_fan.fst s) (binary_fan.snd s ≫ binary_fan.fst sYZ)) :=
  rfl

@[simp] theorem binary_fan.assoc_inv_snd {C : Type u} [category C] {X : C} {Y : C} {Z : C}
    {sXY : binary_fan X Y} (P : is_limit sXY) {sYZ : binary_fan Y Z}
    (s : binary_fan X (cone.X sYZ)) :
    binary_fan.snd (binary_fan.assoc_inv P s) = binary_fan.snd s ≫ binary_fan.snd sYZ :=
  rfl

/--
If all the binary fans involved a limit cones, `binary_fan.assoc` produces another limit cone.
-/
def is_limit.assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} {sXY : binary_fan X Y}
    (P : is_limit sXY) {sYZ : binary_fan Y Z} (Q : is_limit sYZ) {s : binary_fan (cone.X sXY) Z}
    (R : is_limit s) : is_limit (binary_fan.assoc Q s) :=
  is_limit.mk fun (t : cone (pair X (cone.X sYZ))) => is_limit.lift R (binary_fan.assoc_inv P t)

/--
Given two pairs of limit cones corresponding to the parenthesisations of `X × Y × Z`,
we obtain an isomorphism between the cone points.
-/
def binary_fan.associator {C : Type u} [category C] {X : C} {Y : C} {Z : C} {sXY : binary_fan X Y}
    (P : is_limit sXY) {sYZ : binary_fan Y Z} (Q : is_limit sYZ) {s : binary_fan (cone.X sXY) Z}
    (R : is_limit s) {t : binary_fan X (cone.X sYZ)} (S : is_limit t) : cone.X s ≅ cone.X t :=
  is_limit.cone_point_unique_up_to_iso (is_limit.assoc P Q R) S

/--
Given a fixed family of limit data for every pair `X Y`, we obtain an associator.
-/
def binary_fan.associator_of_limit_cone {C : Type u} [category C]
    (L : (X Y : C) → limit_cone (pair X Y)) (X : C) (Y : C) (Z : C) :
    cone.X (limit_cone.cone (L (cone.X (limit_cone.cone (L X Y))) Z)) ≅
        cone.X (limit_cone.cone (L X (cone.X (limit_cone.cone (L Y Z))))) :=
  binary_fan.associator (limit_cone.is_limit (L X Y)) (limit_cone.is_limit (L Y Z))
    (limit_cone.is_limit (L (cone.X (limit_cone.cone (L X Y))) Z))
    (limit_cone.is_limit (L X (cone.X (limit_cone.cone (L Y Z)))))

/--
Construct a left unitor from specified limit cones.
-/
def binary_fan.left_unitor {C : Type u} [category C] {X : C} {s : cone (functor.empty C)}
    (P : is_limit s) {t : binary_fan (cone.X s) X} (Q : is_limit t) : cone.X t ≅ X :=
  iso.mk (binary_fan.snd t)
    (is_limit.lift Q
      (binary_fan.mk
        (is_limit.lift P
          (cone.mk X
            (nat_trans.mk
              (pempty.rec
                fun (n : pempty) =>
                  functor.obj (functor.obj (functor.const (discrete pempty)) X) n ⟶
                    functor.obj (functor.empty C) n))))
        𝟙))

/--
Construct a right unitor from specified limit cones.
-/
def binary_fan.right_unitor {C : Type u} [category C] {X : C} {s : cone (functor.empty C)}
    (P : is_limit s) {t : binary_fan X (cone.X s)} (Q : is_limit t) : cone.X t ≅ X :=
  iso.mk (binary_fan.fst t)
    (is_limit.lift Q
      (binary_fan.mk 𝟙
        (is_limit.lift P
          (cone.mk X
            (nat_trans.mk
              (pempty.rec
                fun (n : pempty) =>
                  functor.obj (functor.obj (functor.const (discrete pempty)) X) n ⟶
                    functor.obj (functor.empty C) n))))))

end limits

namespace monoidal_of_chosen_finite_products

/-- Implementation of the tensor product for `monoidal_of_chosen_finite_products`. -/
def tensor_obj {C : Type u} [category C] (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y))
    (X : C) (Y : C) : C :=
  limits.cone.X (limits.limit_cone.cone (ℬ X Y))

/-- Implementation of the tensor product of morphisms for `monoidal_of_chosen_finite_products`. -/
def tensor_hom {C : Type u} [category C] (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y))
    {W : C} {X : C} {Y : C} {Z : C} (f : W ⟶ X) (g : Y ⟶ Z) : tensor_obj ℬ W Y ⟶ tensor_obj ℬ X Z :=
  subtype.val
    (limits.binary_fan.is_limit.lift' (limits.limit_cone.is_limit (ℬ X Z))
      (nat_trans.app (limits.cone.π (limits.limit_cone.cone (ℬ W Y))) limits.walking_pair.left ≫ f)
      (nat_trans.app (limits.cone.π (limits.limit_cone.cone (ℬ W Y))) limits.walking_pair.right ≫
        g))

theorem tensor_id {C : Type u} [category C] (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y))
    (X₁ : C) (X₂ : C) : tensor_hom ℬ 𝟙 𝟙 = 𝟙 :=
  sorry

theorem tensor_comp {C : Type u} [category C] (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y))
    {X₁ : C} {Y₁ : C} {Z₁ : C} {X₂ : C} {Y₂ : C} {Z₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂)
    (g₁ : Y₁ ⟶ Z₁) (g₂ : Y₂ ⟶ Z₂) :
    tensor_hom ℬ (f₁ ≫ g₁) (f₂ ≫ g₂) = tensor_hom ℬ f₁ f₂ ≫ tensor_hom ℬ g₁ g₂ :=
  sorry

theorem pentagon {C : Type u} [category C] (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y))
    (W : C) (X : C) (Y : C) (Z : C) :
    tensor_hom ℬ (iso.hom (limits.binary_fan.associator_of_limit_cone ℬ W X Y)) 𝟙 ≫
          iso.hom (limits.binary_fan.associator_of_limit_cone ℬ W (tensor_obj ℬ X Y) Z) ≫
            tensor_hom ℬ 𝟙 (iso.hom (limits.binary_fan.associator_of_limit_cone ℬ X Y Z)) =
        iso.hom (limits.binary_fan.associator_of_limit_cone ℬ (tensor_obj ℬ W X) Y Z) ≫
          iso.hom (limits.binary_fan.associator_of_limit_cone ℬ W X (tensor_obj ℬ Y Z)) :=
  sorry

theorem triangle {C : Type u} [category C] (𝒯 : limits.limit_cone (functor.empty C))
    (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y)) (X : C) (Y : C) :
    iso.hom
            (limits.binary_fan.associator_of_limit_cone ℬ X
              (limits.cone.X (limits.limit_cone.cone 𝒯)) Y) ≫
          tensor_hom ℬ 𝟙
            (iso.hom
              (limits.binary_fan.left_unitor (limits.limit_cone.is_limit 𝒯)
                (limits.limit_cone.is_limit (ℬ (limits.cone.X (limits.limit_cone.cone 𝒯)) Y)))) =
        tensor_hom ℬ
          (iso.hom
            (limits.binary_fan.right_unitor (limits.limit_cone.is_limit 𝒯)
              (limits.limit_cone.is_limit (ℬ X (limits.cone.X (limits.limit_cone.cone 𝒯))))))
          𝟙 :=
  sorry

theorem left_unitor_naturality {C : Type u} [category C] (𝒯 : limits.limit_cone (functor.empty C))
    (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y)) {X₁ : C} {X₂ : C} (f : X₁ ⟶ X₂) :
    tensor_hom ℬ 𝟙 f ≫
          iso.hom
            (limits.binary_fan.left_unitor (limits.limit_cone.is_limit 𝒯)
              (limits.limit_cone.is_limit (ℬ (limits.cone.X (limits.limit_cone.cone 𝒯)) X₂))) =
        iso.hom
            (limits.binary_fan.left_unitor (limits.limit_cone.is_limit 𝒯)
              (limits.limit_cone.is_limit (ℬ (limits.cone.X (limits.limit_cone.cone 𝒯)) X₁))) ≫
          f :=
  sorry

theorem right_unitor_naturality {C : Type u} [category C] (𝒯 : limits.limit_cone (functor.empty C))
    (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y)) {X₁ : C} {X₂ : C} (f : X₁ ⟶ X₂) :
    tensor_hom ℬ f 𝟙 ≫
          iso.hom
            (limits.binary_fan.right_unitor (limits.limit_cone.is_limit 𝒯)
              (limits.limit_cone.is_limit (ℬ X₂ (limits.cone.X (limits.limit_cone.cone 𝒯))))) =
        iso.hom
            (limits.binary_fan.right_unitor (limits.limit_cone.is_limit 𝒯)
              (limits.limit_cone.is_limit (ℬ X₁ (limits.cone.X (limits.limit_cone.cone 𝒯))))) ≫
          f :=
  sorry

theorem associator_naturality {C : Type u} [category C]
    (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y)) {X₁ : C} {X₂ : C} {X₃ : C} {Y₁ : C}
    {Y₂ : C} {Y₃ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃) :
    tensor_hom ℬ (tensor_hom ℬ f₁ f₂) f₃ ≫
          iso.hom (limits.binary_fan.associator_of_limit_cone ℬ Y₁ Y₂ Y₃) =
        iso.hom (limits.binary_fan.associator_of_limit_cone ℬ X₁ X₂ X₃) ≫
          tensor_hom ℬ f₁ (tensor_hom ℬ f₂ f₃) :=
  sorry

end monoidal_of_chosen_finite_products

/-- A category with a terminal object and binary products has a natural monoidal structure. -/
def monoidal_of_chosen_finite_products {C : Type u} [category C]
    (𝒯 : limits.limit_cone (functor.empty C))
    (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y)) : monoidal_category C :=
  monoidal_category.mk (fun (X Y : C) => sorry)
    (fun (_x _x_1 _x_2 _x_3 : C) (f : _x ⟶ _x_1) (g : _x_2 ⟶ _x_3) => sorry)
    (limits.cone.X (limits.limit_cone.cone 𝒯))
    (fun (X Y Z : C) => limits.binary_fan.associator_of_limit_cone ℬ X Y Z)
    (fun (X : C) =>
      limits.binary_fan.left_unitor (limits.limit_cone.is_limit 𝒯)
        (limits.limit_cone.is_limit (ℬ (limits.cone.X (limits.limit_cone.cone 𝒯)) X)))
    fun (X : C) =>
      limits.binary_fan.right_unitor (limits.limit_cone.is_limit 𝒯)
        (limits.limit_cone.is_limit (ℬ X (limits.cone.X (limits.limit_cone.cone 𝒯))))

namespace monoidal_of_chosen_finite_products

/--
A type synonym for `C` carrying a monoidal category structure corresponding to
a fixed choice of limit data for the empty functor, and for `pair X Y` for every `X Y : C`.

This is an implementation detail for `symmetric_of_chosen_finite_products`.
-/
def monoidal_of_chosen_finite_products_synonym {C : Type u} [category C]
    (𝒯 : limits.limit_cone (functor.empty C))
    (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y)) :=
  C

protected instance monoidal_of_chosen_finite_products_synonym.category_theory.monoidal_category
    {C : Type u} [category C] (𝒯 : limits.limit_cone (functor.empty C))
    (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y)) :
    monoidal_category (monoidal_of_chosen_finite_products_synonym 𝒯 ℬ) :=
  monoidal_of_chosen_finite_products 𝒯 ℬ

theorem braiding_naturality {C : Type u} [category C]
    (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y)) {X : C} {X' : C} {Y : C} {Y' : C}
    (f : X ⟶ Y) (g : X' ⟶ Y') :
    tensor_hom ℬ f g ≫
          iso.hom
            (limits.binary_fan.braiding (limits.limit_cone.is_limit (ℬ Y Y'))
              (limits.limit_cone.is_limit (ℬ Y' Y))) =
        iso.hom
            (limits.binary_fan.braiding (limits.limit_cone.is_limit (ℬ X X'))
              (limits.limit_cone.is_limit (ℬ X' X))) ≫
          tensor_hom ℬ g f :=
  sorry

theorem hexagon_forward {C : Type u} [category C]
    (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y)) (X : C) (Y : C) (Z : C) :
    iso.hom (limits.binary_fan.associator_of_limit_cone ℬ X Y Z) ≫
          iso.hom
              (limits.binary_fan.braiding (limits.limit_cone.is_limit (ℬ X (tensor_obj ℬ Y Z)))
                (limits.limit_cone.is_limit (ℬ (tensor_obj ℬ Y Z) X))) ≫
            iso.hom (limits.binary_fan.associator_of_limit_cone ℬ Y Z X) =
        tensor_hom ℬ
            (iso.hom
              (limits.binary_fan.braiding (limits.limit_cone.is_limit (ℬ X Y))
                (limits.limit_cone.is_limit (ℬ Y X))))
            𝟙 ≫
          iso.hom (limits.binary_fan.associator_of_limit_cone ℬ Y X Z) ≫
            tensor_hom ℬ 𝟙
              (iso.hom
                (limits.binary_fan.braiding (limits.limit_cone.is_limit (ℬ X Z))
                  (limits.limit_cone.is_limit (ℬ Z X)))) :=
  sorry

theorem hexagon_reverse {C : Type u} [category C]
    (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y)) (X : C) (Y : C) (Z : C) :
    iso.inv (limits.binary_fan.associator_of_limit_cone ℬ X Y Z) ≫
          iso.hom
              (limits.binary_fan.braiding (limits.limit_cone.is_limit (ℬ (tensor_obj ℬ X Y) Z))
                (limits.limit_cone.is_limit (ℬ Z (tensor_obj ℬ X Y)))) ≫
            iso.inv (limits.binary_fan.associator_of_limit_cone ℬ Z X Y) =
        tensor_hom ℬ 𝟙
            (iso.hom
              (limits.binary_fan.braiding (limits.limit_cone.is_limit (ℬ Y Z))
                (limits.limit_cone.is_limit (ℬ Z Y)))) ≫
          iso.inv (limits.binary_fan.associator_of_limit_cone ℬ X Z Y) ≫
            tensor_hom ℬ
              (iso.hom
                (limits.binary_fan.braiding (limits.limit_cone.is_limit (ℬ X Z))
                  (limits.limit_cone.is_limit (ℬ Z X))))
              𝟙 :=
  sorry

theorem symmetry {C : Type u} [category C] (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y))
    (X : C) (Y : C) :
    iso.hom
            (limits.binary_fan.braiding (limits.limit_cone.is_limit (ℬ X Y))
              (limits.limit_cone.is_limit (ℬ Y X))) ≫
          iso.hom
            (limits.binary_fan.braiding (limits.limit_cone.is_limit (ℬ Y X))
              (limits.limit_cone.is_limit (ℬ X Y))) =
        𝟙 :=
  sorry

end monoidal_of_chosen_finite_products

/--
The monoidal structure coming from finite products is symmetric.
-/
def symmetric_of_chosen_finite_products {C : Type u} [category C]
    (𝒯 : limits.limit_cone (functor.empty C))
    (ℬ : (X Y : C) → limits.limit_cone (limits.pair X Y)) :
    symmetric_category
        (monoidal_of_chosen_finite_products.monoidal_of_chosen_finite_products_synonym 𝒯 ℬ) :=
  symmetric_category.mk

end Mathlib


import Smt

variable (f : Int → Int)

example (h : f 10 = 10) : let y := 10; f y = 10 := by
  smt [h]

example (h : let y := 10; f y = 10) : f 10 = 10 := by
  smt [h]

example (h : f 10 = 10) : f 10 = 10 := by
  let z : Int := 10
  have : 10 = z := rfl
  rw [this]
  smt [h, z]
  exact h

example (h : f 10 = 10) : f 10 = 10 := by
  let z : Int := 10
  let y : Int := z
  have : 10 = y := rfl
  rw [this]
  smt [h, y, z]
  exact h

example (h : f 10 = 10) : f 10 = 10 := by
  let z (_ : Int) : Int := f 10
  have : f 10 = z 3 := rfl
  rw [this]
  smt [h, z]
  exact h


import modal_logic.basic

namespace ontological_argument

open modal_logic

open_locale modal_frame.universal

constant object : Type

variables [world.{0}] (w : World) (p q : object → MProp)

constant ex (x : object) : MProp
constant pos : (object → MProp) → MProp
axiom pos_of_imp_of_pos : w ⊩ □(λ v, ∀ x, v ⊩ ex x ⇒ p x ⇒ q x) ⇒ pos p ⇒ pos q
axiom not_pos : w ⊩ ¬pos p ⇔ pos (not ∘ p)

lemma not_pos_eq_pos_not : (¬pos p) = pos (not ∘ p) :=
begin
  ext,
  apply not_pos,
end

theorem exists_of_pos : w ⊩ pos p ⇒ ◇(λ v, ∃ x, v ⊩ ex x ∧ p x) :=
begin
  intros h,
  rw ← modal_logic.not_not (◇_),
  intros h',
  simp only [not_lam, not_poss] at h',
  simp only [not_exists, not_sat, modal_logic.not_and, or_eq_not_imp_left, modal_logic.not_not] at h',
  have h'' := h,
  revert h'',
  show w ⊩ ¬pos p,
  rw not_pos_eq_pos_not,
  apply pos_of_imp_of_pos _ p _ _ h,
  intros v h_v x h_x h'',
  apply h' v h_v x h_x,
end

def godlike (g : object) : MProp := λ w, ∀ p, w ⊩ pos p ⇒ p g
axiom pos_godlike : w ⊩ pos godlike

theorem exists_godlike : w ⊩ ◇(λ v, ∃ x, v ⊩ ex x ∧ godlike x) :=
begin
  apply exists_of_pos,
  apply pos_godlike,
end

def ess (p : object → MProp) (x : object) : MProp := ex x ∧ p x ∧ (λ w, ∀ q : object → MProp, w ⊩ q x ⇒ □(λ v, ∀ y, v ⊩ ex y ⇒ p y ⇒ q y))
axiom nec_pos_of_pos : w ⊩ pos p ⇒ □pos p

lemma pos_of_godlike (x) : w ⊩ godlike x ⇒ p x ⇒ pos p :=
begin
  intros h h',
  by_contra h'',
  simp only [not_sat, not_pos_eq_pos_not] at h'',
  apply h _ h'' h',
end

theorem ess_godlike (x) : w ⊩ ex x ⇒ godlike x ⇒ ess godlike x :=
begin
  intros h h',
  split,
  {
    apply h,
  },
  split,
  {
    apply h',
  },
  {
    intros p h'' v h_v y h''' h'''',
    apply h'''',
    apply nec_pos_of_pos w _ _ v h_v,
    apply pos_of_godlike _ _ _ h' h'',
  },
end

def nec_ex (x : object) : MProp := λ w, ∀ p, w ⊩ ess p x ⇒ □(λ v, ∃ y, v ⊩ ex y ∧ p y)
axiom pos_nec_ex : w ⊩ pos nec_ex

lemma ex_of_godlike (x) : w ⊩ godlike x ⇒ ex x :=
begin
  intros h,
  rcases exists_godlike w with ⟨v, h_v, ⟨y, h', h''⟩⟩,
  apply h,
  apply nec_pos_of_pos v ex _ w trivial,
  apply pos_of_godlike _ _ _ h'' h',
end

theorem god_nec_ex : ∃ x, w ⊩ ex x ∧ godlike x :=
begin
  rcases exists_godlike w with ⟨v, h_v, x, h, h'⟩,
  apply h' _ (pos_nec_ex _) _ (ess_godlike _ _ h h') w trivial,
end

theorem modal_collapse (w v : World) : w = v :=
begin
  rcases god_nec_ex w with ⟨god_w, -, h⟩,
  rcases god_nec_ex v with ⟨god_v, -, h'⟩,
  apply h' (λ _ u, w = u),
  apply nec_pos_of_pos w _ _ v trivial,
  apply pos_of_godlike _ _ _ h,
  apply rfl,
end

end ontological_argument