import ring_theory.algebra
import tactic

/- IMPORTANT TODO: generalize this theory to bimodules. Important cases for mathematical
physics are left out. -/

open algebra ring_hom

@[protect_proj, ancestor add_left_cancel_semigroup add_comm_monoid]
class add_left_cancel_comm_monoid (M : Type*) extends add_left_cancel_semigroup M, add_comm_monoid M

variables (R : Type*) (A : Type*) [comm_semiring R] [comm_semiring A] [algebra R A]
  (M : Type*) [add_left_cancel_monoid M] [semimodule A M]

def transitive_scalar (R : Type*) (A : Type*) (M : Type*)
  [comm_semiring R] [semiring A] [algebra R A]
  [add_comm_monoid M] [semimodule A M] : has_scalar R M :=
{ smul := λ r m, ((algebra_map R A) r) • m, }

def transitive_module (R : Type*) (A : Type*) (M : Type*)
  [comm_semiring R] [semiring A] [algebra R A] [add_comm_monoid M] [semimodule A M] :
  semimodule R M :=
{ smul_add := λ r x y, smul_add _ _ _,
  smul_zero := λ r, smul_zero _,
  zero_smul := λ x, show algebra_map R A 0 • x = 0, by rw [map_zero, zero_smul],
  one_smul := λ x, show algebra_map R A 1 • x = x, by rw [map_one, one_smul],
  mul_smul := λ r s x, show algebra_map R A (r * s) • x =
    algebra_map R A r • algebra_map R A s • x, by rw [map_mul, mul_smul],
  add_smul := λ r s x, show algebra_map R A (r + s) • x =
    algebra_map R A r • x + algebra_map R A s • x, by rw [map_add, add_smul],
  .. transitive_scalar R A M }

class compatible_semimodule (R : Type*) (A : Type*) [comm_semiring R] [semiring A]
  [algebra R A] (M : Type*) [add_comm_monoid M] [semimodule A M] [semimodule R M] :=
(compatible {r : R} {m : M} : r • m = ((algebra_map R A) r) • m)

structure derivation [semimodule A M] [semimodule R M] [compatible_semimodule R A M]
  extends A →ₗ[R] M :=
(leibniz' (a b : A) : to_fun (a * b) = a • to_fun b + b • to_fun a)

section

variables {R} {A} {M} [semimodule R M] [compatible_semimodule R A M]

namespace derivation

instance : has_coe_to_fun (derivation R A M) := ⟨_, λ D, D.to_linear_map.to_fun⟩

instance has_coe_to_linear_map : has_coe (derivation R A M) (A →ₗ[R] M) :=
  ⟨λ D, D.to_linear_map⟩

lemma one_mul_one (M : Type*) [monoid M] : 1 * 1 = 1 := one_mul 1

section
variables {R A} (D : derivation R A M) (r : R) (a b : A)
@[simp] lemma map_add : D (a + b) = D a + D b := is_add_hom.map_add D a b
@[simp] lemma map_zero : D 0 = 0 := is_add_monoid_hom.map_zero D
@[simp] lemma map_mul : D (a * b) = a • D b + b • D a := D.leibniz' _ _
@[simp] lemma leibniz : D (a * b) = b • D a + a • D b := (D.leibniz' a b).trans $ add_comm _ _
@[simp] lemma map_algebra_map : D 1 = 0 :=
begin
  have h : D 1 = D (1 * 1) := by rw mul_one,
  rw [leibniz D 1 1, one_smul] at h,
  exact add_left_cancel_monoid,
end
@[simp] lemma map_algebra_map : D (algebra_map R A r) = 0 :=
begin
  rw [←mul_one r, monoid_hom.map_mul (algebra_map R A).to_monoid_hom r 1],
end

variables [comm_ring R] [ring A] [algebra R A] [add_comm_group M] [module A M]

@[simp] lemma map_neg : D (-a) = -D a := is_add_group_hom.map_neg D a
@[simp] lemma map_sub : D (a - b) = D a - D b := is_add_group_hom.map_sub D a b

variables {D1 D2 : derivation R A}

lemma coe_injective (H : ⇑D1 = D2) : D1 = D2 :=
by cases D1; cases D2; congr'; exact linear_map.coe_injective H

@[ext] theorem ext (H : ∀ a, D1 a = D2 a) : D1 = D2 :=
coe_injective $ funext H

instance : add_comm_group (derivation R A) :=
by refine
{ add := λ D1 D2, ⟨λ a, D1 a + D2 a,
    λ a1 a2, by rw [D1.map_add, D2.map_add, add_comm₄],
    λ a1 a2, by rw [D1.map_mul, D2.map_mul, smul_add, smul_add, add_comm₄],
    λ r, by rw [D1.map_algebra_map, D2.map_algebra_map, add_zero]⟩,
  zero := ⟨λ a, 0,
    λ a1 a2, by rw add_zero,
    λ a1 a2, by rw [smul_zero, smul_zero, add_zero],
    λ r, rfl⟩,
  neg := λ D, ⟨λ a, -D a,
    λ a1 a2, by rw [D.map_add, neg_add],
    λ a1 a2, by rw [D.map_mul, neg_add, smul_neg, smul_neg],
    λ r, by rw [D.map_algebra_map, neg_zero]⟩,
  .. }

instance : module A (derivation R A) :=
{ smul := λ a D, ⟨λ b, a • D b,
    λ a1 a2, by rw [D.map_add, smul_add],
    λ a1 a2, by rw [D.map_mul, smul_add, smul_smul, smul_smul, mul_comm, mul_smul, mul_comm, mul_smul],
    λ s, by rw [D.map_algebra_map, smul_zero]⟩,
  mul_smul := λ a1 a2 D, ext $ λ b, mul_smul _ _ _,
  one_smul := λ D, ext $ λ b, one_smul A _,
  smul_add := λ a D1 D2, ext $ λ b, smul_add _ _ _,
  smul_zero := λ a, ext $ λ b, smul_zero _,
  add_smul := λ a1 a2 D, ext $ λ b, add_smul _ _ _,
  zero_smul := λ D, ext $ λ b, zero_smul A _ }

variables {R A M}
def comp {N : Type*} [add_comm_group N] [module A N]
  (D : derivation R A M) (f : M →ₗ[A] N) : derivation R A N :=
{ to_fun := λ a, f (D a),
  add := λ a1 a2, by rw [D.map_add, f.map_add],
  mul := λ a1 a2, by rw [D.map_mul, f.map_add, f.map_smul, f.map_smul],
  algebra := λ r, by rw [D.map_algebra_map, f.map_zero] }

end derivation

end


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.concrete_category
import group_theory.quotient_group
import category_theory.limits.shapes.kernels
import algebra.category.Module.basic

/-!
# The category of R-modules has all colimits.

This file uses a "pre-automated" approach, just as for `Mon/colimits.lean`.

Note that finite colimits can already be obtained from the instance `abelian (Module R)`.

TODO:
In fact, in `Module R` there is a much nicer model of colimits as quotients
of finitely supported functions, and we really should implement this as well (or instead).
-/

universes u v w

open category_theory
open category_theory.limits

variables {R : Type u} [ring R]

-- [ROBOT VOICE]:
-- You should pretend for now that this file was automatically generated.
-- It follows the same template as colimits in Mon.

namespace Module.colimits
/-!
We build the colimit of a diagram in `Module` by constructing the
free group on the disjoint union of all the abelian groups in the diagram,
then taking the quotient by the abelian group laws within each abelian group,
and the identifications given by the morphisms in the diagram.
-/

variables {J : Type w} [category.{v} J] (F : J ⥤ Module.{max u v w} R)

/--
An inductive type representing all module expressions (without relations)
on a collection of types indexed by the objects of `J`.
-/
inductive prequotient
-- There's always `of`
| of : Π (j : J) (x : F.obj j), prequotient
-- Then one generator for each operation
| zero : prequotient
| neg : prequotient → prequotient
| add : prequotient → prequotient → prequotient
| smul : R → prequotient → prequotient

instance : inhabited (prequotient F) := ⟨prequotient.zero⟩

open prequotient

/--
The relation on `prequotient` saying when two expressions are equal
because of the module laws, or
because one element is mapped to another by a morphism in the diagram.
-/
inductive relation : prequotient F → prequotient F → Prop
-- Make it an equivalence relation:
| refl : Π (x), relation x x
| symm : Π (x y) (h : relation x y), relation y x
| trans : Π (x y z) (h : relation x y) (k : relation y z), relation x z
-- There's always a `map` relation
| map : Π (j j' : J) (f : j ⟶ j') (x : F.obj j), relation (of j' (F.map f x)) (of j x)
-- Then one relation per operation, describing the interaction with `of`
| zero : Π (j), relation (of j 0) zero
| neg : Π (j) (x : F.obj j), relation (of j (-x)) (neg (of j x))
| add : Π (j) (x y : F.obj j), relation (of j (x + y)) (add (of j x) (of j y))
| smul : Π (j) (s) (x : F.obj j), relation (of j (s • x)) (smul s (of j x))
-- Then one relation per argument of each operation
| neg_1 : Π (x x') (r : relation x x'), relation (neg x) (neg x')
| add_1 : Π (x x' y) (r : relation x x'), relation (add x y) (add x' y)
| add_2 : Π (x y y') (r : relation y y'), relation (add x y) (add x y')
| smul_1 : Π (s) (x x') (r : relation x x'), relation (smul s x) (smul s x')
-- And one relation per axiom
| zero_add      : Π (x), relation (add zero x) x
| add_zero      : Π (x), relation (add x zero) x
| add_left_neg  : Π (x), relation (add (neg x) x) zero
| add_comm      : Π (x y), relation (add x y) (add y x)
| add_assoc     : Π (x y z), relation (add (add x y) z) (add x (add y z))
| one_smul      : Π (x), relation (smul 1 x) x
| mul_smul      : Π (s t) (x), relation (smul (s * t) x) (smul s (smul t x))
| smul_add      : Π (s) (x y), relation (smul s (add x y)) (add (smul s x) (smul s y))
| smul_zero     : Π (s), relation (smul s zero) zero
| add_smul      : Π (s t) (x), relation (smul (s + t) x) (add (smul s x) (smul t x))
| zero_smul     : Π (x), relation (smul 0 x) zero

/--
The setoid corresponding to module expressions modulo module relations and identifications.
-/
def colimit_setoid : setoid (prequotient F) :=
{ r := relation F, iseqv := ⟨relation.refl, relation.symm, relation.trans⟩ }
attribute [instance] colimit_setoid

/--
The underlying type of the colimit of a diagram in `Module R`.
-/
@[derive inhabited]
def colimit_type : Type (max u v w) := quotient (colimit_setoid F)

instance : add_comm_group (colimit_type F) :=
{ zero :=
  begin
    exact quot.mk _ zero
  end,
  neg :=
  begin
    fapply @quot.lift,
    { intro x,
      exact quot.mk _ (neg x) },
    { intros x x' r,
      apply quot.sound,
      exact relation.neg_1 _ _ r },
  end,
  add :=
  begin
    fapply @quot.lift _ _ ((colimit_type F) → (colimit_type F)),
    { intro x,
      fapply @quot.lift,
      { intro y,
        exact quot.mk _ (add x y) },
      { intros y y' r,
        apply quot.sound,
        exact relation.add_2 _ _ _ r } },
    { intros x x' r,
      funext y,
      induction y,
      dsimp,
      apply quot.sound,
      { exact relation.add_1 _ _ _ r },
      { refl } },
  end,
  zero_add := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.zero_add,
    refl,
  end,
  add_zero := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.add_zero,
    refl,
  end,
  add_left_neg := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.add_left_neg,
    refl,
  end,
  add_comm := λ x y,
  begin
    induction x,
    induction y,
    dsimp,
    apply quot.sound,
    apply relation.add_comm,
    refl,
    refl,
  end,
  add_assoc := λ x y z,
  begin
    induction x,
    induction y,
    induction z,
    dsimp,
    apply quot.sound,
    apply relation.add_assoc,
    refl,
    refl,
    refl,
  end, }

instance : module R (colimit_type F) :=
{ smul := λ s,
  begin
    fapply @quot.lift,
    { intro x,
      exact quot.mk _ (smul s x) },
    { intros x x' r,
      apply quot.sound,
      exact relation.smul_1 s _ _ r },
  end,
  one_smul := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.one_smul,
    refl,
  end,
  mul_smul := λ s t x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.mul_smul,
    refl,
  end,
  smul_add := λ s x y,
  begin
    induction x,
    induction y,
    dsimp,
    apply quot.sound,
    apply relation.smul_add,
    refl,
    refl,
  end,
  smul_zero := λ s, begin apply quot.sound, apply relation.smul_zero, end,
  add_smul := λ s t x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.add_smul,
    refl,
  end,
  zero_smul := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.zero_smul,
    refl,
  end, }

@[simp] lemma quot_zero : quot.mk setoid.r zero = (0 : colimit_type F) := rfl
@[simp] lemma quot_neg (x) :
  quot.mk setoid.r (neg x) = (-(quot.mk setoid.r x) : colimit_type F) := rfl
@[simp] lemma quot_add (x y) :
  quot.mk setoid.r (add x y) = ((quot.mk setoid.r x) + (quot.mk setoid.r y) : colimit_type F) := rfl
@[simp] lemma quot_smul (s x) :
  quot.mk setoid.r (smul s x) = (s • (quot.mk setoid.r x) : colimit_type F) := rfl

/-- The bundled module giving the colimit of a diagram. -/
def colimit : Module R := Module.of R (colimit_type F)

/-- The function from a given module in the diagram to the colimit module. -/
def cocone_fun (j : J) (x : F.obj j) : colimit_type F :=
quot.mk _ (of j x)

/-- The group homomorphism from a given module in the diagram to the colimit module. -/
def cocone_morphism (j : J) : F.obj j ⟶ colimit F :=
{ to_fun := cocone_fun F j,
  map_smul' := by { intros, apply quot.sound, apply relation.smul, },
  map_add' := by intros; apply quot.sound; apply relation.add }

@[simp] lemma cocone_naturality {j j' : J} (f : j ⟶ j') :
  F.map f ≫ (cocone_morphism F j') = cocone_morphism F j :=
begin
  ext,
  apply quot.sound,
  apply relation.map,
end

@[simp] lemma cocone_naturality_components (j j' : J) (f : j ⟶ j') (x : F.obj j) :
  (cocone_morphism F j') (F.map f x) = (cocone_morphism F j) x :=
by { rw ←cocone_naturality F f, refl }

/-- The cocone over the proposed colimit module. -/
def colimit_cocone : cocone F :=
{ X := colimit F,
  ι :=
  { app := cocone_morphism F } }.

/-- The function from the free module on the diagram to the cone point of any other cocone. -/
@[simp] def desc_fun_lift (s : cocone F) : prequotient F → s.X
| (of j x)  := (s.ι.app j) x
| zero      := 0
| (neg x)   := -(desc_fun_lift x)
| (add x y) := desc_fun_lift x + desc_fun_lift y
| (smul s x) := s • (desc_fun_lift x)

/-- The function from the colimit module to the cone point of any other cocone. -/
def desc_fun (s : cocone F) : colimit_type F → s.X :=
begin
  fapply quot.lift,
  { exact desc_fun_lift F s },
  { intros x y r,
    induction r; try { dsimp },
    -- refl
    { refl },
    -- symm
    { exact r_ih.symm },
    -- trans
    { exact eq.trans r_ih_h r_ih_k },
    -- map
    { simp, },
    -- zero
    { simp, },
    -- neg
    { simp, },
    -- add
    { simp, },
    -- smul,
    { simp, },
    -- neg_1
    { rw r_ih, },
    -- add_1
    { rw r_ih, },
    -- add_2
    { rw r_ih, },
    -- smul_1
    { rw r_ih, },
    -- zero_add
    { rw zero_add, },
    -- add_zero
    { rw add_zero, },
    -- add_left_neg
    { rw add_left_neg, },
    -- add_comm
    { rw add_comm, },
    -- add_assoc
    { rw add_assoc, },
    -- one_smul
    { rw one_smul, },
    -- mul_smul
    { rw mul_smul, },
    -- smul_add
    { rw smul_add, },
    -- smul_zero
    { rw smul_zero, },
    -- add_smul
    { rw add_smul, },
    -- zero_smul
    { rw zero_smul, }, }
end

/-- The group homomorphism from the colimit module to the cone point of any other cocone. -/
def desc_morphism (s : cocone F) : colimit F ⟶ s.X :=
{ to_fun := desc_fun F s,
  map_smul' := λ s x, by { induction x; refl, },
  map_add' := λ x y, by { induction x; induction y; refl }, }

/-- Evidence that the proposed colimit is the colimit. -/
def colimit_cocone_is_colimit : is_colimit (colimit_cocone F) :=
{ desc := λ s, desc_morphism F s,
  uniq' := λ s m w,
  begin
    ext,
    induction x,
    induction x,
    { have w' := congr_fun (congr_arg (λ f : F.obj x_j ⟶ s.X, (f : F.obj x_j → s.X)) (w x_j)) x_x,
      erw w',
      refl, },
    { simp *, },
    { simp *, },
    { simp *, },
    { simp *, },
    refl
  end }.

instance has_colimits_Module : has_colimits (Module.{max v u} R) :=
{ has_colimits_of_shape := λ J 𝒥, by exactI
  { has_colimit := λ F, has_colimit.mk
    { cocone := colimit_cocone F,
      is_colimit := colimit_cocone_is_colimit F } } }

-- We manually add a `has_colimits` instance with universe parameters swapped, for otherwise
-- the instance is not found by typeclass search.
instance has_colimits_Module' (R : Type u) [ring R] :
  has_colimits (Module.{max u v} R) :=
Module.colimits.has_colimits_Module.{u v}

-- We manually add a `has_colimits` instance with equal universe parameters, for otherwise
-- the instance is not found by typeclass search.
instance has_colimits_Module'' (R : Type u) [ring R] :
  has_colimits (Module.{u} R) :=
Module.colimits.has_colimits_Module.{u u}

-- Sanity checks, just to make sure typeclass search can find the instances we want.
example (R : Type u) [ring R] : has_colimits (Module.{max v u} R) := infer_instance
example (R : Type u) [ring R] : has_colimits (Module.{max u v} R) := infer_instance
example (R : Type u) [ring R] : has_colimits (Module.{u} R) := infer_instance

end Module.colimits


class has_note (M : Type) where
  note : M

notation "♩" => has_note.note

class has_note2 (M : Type) extends has_note M

variable {ι : Type} (β : ι → Type)

structure foo [∀ i, has_note (β i)] : Type where
  to_fun : ∀ i, β i

instance foo.has_note [∀ i, has_note (β i)] : has_note (foo (λ i => β i)) where
  note := { to_fun := λ _ => ♩ }

instance foo.has_note2 [∀ i, has_note2 (β i)] : has_note2 (foo (λ i => β i)) where
  note := ♩

variable (α : Type) (M : Type)

structure bar [has_note M] where
  to_fun : α → M

instance bar.has_note [has_note M] : has_note (bar α M) where
  note := { to_fun := λ _ => ♩ }

instance bar.has_note2 [has_note2 M] : has_note2 (bar α M) where
  note := ♩

example [has_note2 M] : has_note2 (foo (λ (i : ι) => bar (β i) M)) :=
inferInstance

example [has_note2 M] : has_note2 (foo (λ (i : ι) => bar (β i) M)) :=
foo.has_note2 _


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

import measure_theory.measurable_space

/-!
# Sequence of measurable functions associated to a sequence of a.e.-measurable functions

We define here tools to prove statements about limits (infi, supr...) of sequences of
`ae_measurable` functions.
Given a sequence of a.e.-measurable functions `f : ι → α → β` with hypothesis
`hf : ∀ i, ae_measurable (f i) μ`, and a pointwise property `p : α → (ι → β) → Prop` such that we
have `hp : ∀ᵐ x ∂μ, p x (λ n, f n x)`, we define a sequence of measurable functions `ae_seq hf p`
and a measurable set `ae_seq_set hf p`, such that
* `μ (ae_seq_set hf p)ᶜ = 0`
* `x ∈ ae_seq_set hf p → ∀ i : ι, ae_seq hf hp i x = f i x`
* `x ∈ ae_seq_set hf p → p x (λ n, f n x)`
-/

open measure_theory
open_locale classical

variables {α β γ ι : Type*} [measurable_space α] [measurable_space β]
  {f : ι → α → β} {μ : measure α} {p : α → (ι → β) → Prop}

/-- If we have the additional hypothesis `∀ᵐ x ∂μ, p x (λ n, f n x)`, this is a measurable set
whose complement has measure 0 such that for all `x ∈ ae_seq_set`, `f i x` is equal to
`(hf i).mk (f i) x` for all `i` and we have the pointwise property `p x (λ n, f n x)`. -/
def ae_seq_set (hf : ∀ i, ae_measurable (f i) μ) (p : α → (ι → β) → Prop) : set α :=
(to_measurable μ {x | (∀ i, f i x = (hf i).mk (f i) x) ∧ p x (λ n, f n x)}ᶜ)ᶜ

/-- A sequence of measurable functions that are equal to `f` and verify property `p` on the
measurable set `ae_seq_set hf p`. -/
noncomputable
def ae_seq (hf : ∀ i, ae_measurable (f i) μ) (p : α → (ι → β) → Prop) : ι → α → β :=
λ i x, ite (x ∈ ae_seq_set hf p) ((hf i).mk (f i) x) (⟨f i x⟩ : nonempty β).some

namespace ae_seq

section mem_ae_seq_set

lemma mk_eq_fun_of_mem_ae_seq_set (hf : ∀ i, ae_measurable (f i) μ) {x : α}
  (hx : x ∈ ae_seq_set hf p) (i : ι) :
  (hf i).mk (f i) x = f i x :=
begin
  have h_ss : ae_seq_set hf p ⊆ {x | ∀ i, f i x = (hf i).mk (f i) x},
  { rw [ae_seq_set, ←compl_compl {x | ∀ i, f i x = (hf i).mk (f i) x}, set.compl_subset_compl],
    refine set.subset.trans (set.compl_subset_compl.mpr (λ x h, _)) (subset_to_measurable _ _),
    exact h.1, },
  exact (h_ss hx i).symm,
end

lemma ae_seq_eq_mk_of_mem_ae_seq_set (hf : ∀ i, ae_measurable (f i) μ) {x : α}
  (hx : x ∈ ae_seq_set hf p) (i : ι) :
  ae_seq hf p i x = (hf i).mk (f i) x :=
by simp only [ae_seq, hx, if_true]

lemma ae_seq_eq_fun_of_mem_ae_seq_set (hf : ∀ i, ae_measurable (f i) μ) {x : α}
  (hx : x ∈ ae_seq_set hf p) (i : ι) :
  ae_seq hf p i x = f i x :=
by simp only [ae_seq_eq_mk_of_mem_ae_seq_set hf hx i, mk_eq_fun_of_mem_ae_seq_set hf hx i]

lemma prop_of_mem_ae_seq_set (hf : ∀ i, ae_measurable (f i) μ)
  {x : α} (hx : x ∈ ae_seq_set hf p) :
  p x (λ n, ae_seq hf p n x) :=
begin
  simp only [ae_seq, hx, if_true],
  rw funext (λ n, mk_eq_fun_of_mem_ae_seq_set hf hx n),
  have h_ss : ae_seq_set hf p ⊆ {x | p x (λ n, f n x)},
  { rw [←compl_compl {x | p x (λ n, f n x)}, ae_seq_set, set.compl_subset_compl],
    refine set.subset.trans (set.compl_subset_compl.mpr _) (subset_to_measurable _ _),
    exact λ x hx, hx.2, },
  have hx' := set.mem_of_subset_of_mem h_ss hx,
  exact hx',
end

lemma fun_prop_of_mem_ae_seq_set (hf : ∀ i, ae_measurable (f i) μ)
  {x : α} (hx : x ∈ ae_seq_set hf p) :
  p x (λ n, f n x) :=
begin
  have h_eq : (λ n, f n x) = λ n, ae_seq hf p n x,
    from funext (λ n, (ae_seq_eq_fun_of_mem_ae_seq_set hf hx n).symm),
  rw h_eq,
  exact prop_of_mem_ae_seq_set hf hx,
end

end mem_ae_seq_set

lemma measurable (hf : ∀ i, ae_measurable (f i) μ) (p : α → (ι → β) → Prop)
  (i : ι) :
  measurable (ae_seq hf p i) :=
measurable.ite ae_seq_set_measurable_set (hf i).measurable_mk $ measurable_const' $
  λ x y, rfl

lemma measure_compl_ae_seq_set_eq_zero [encodable ι] (hf : ∀ i, ae_measurable (f i) μ)
  (hp : ∀ᵐ x ∂μ, p x (λ n, f n x)) :
  μ (ae_seq_set hf p)ᶜ = 0 :=
begin
  rw [ae_seq_set, compl_compl, measure_to_measurable],
  have hf_eq := λ i, (hf i).ae_eq_mk,
  simp_rw [filter.eventually_eq, ←ae_all_iff] at hf_eq,
  exact filter.eventually.and hf_eq hp,
end

lemma ae_seq_eq_mk_ae [encodable ι] (hf : ∀ i, ae_measurable (f i) μ)
  (hp : ∀ᵐ x ∂μ, p x (λ n, f n x)) :
  ∀ᵐ (a : α) ∂μ, ∀ (i : ι), ae_seq hf p i a = (hf i).mk (f i) a :=
begin
  have h_ss : ae_seq_set hf p ⊆ {a : α | ∀ i, ae_seq hf p i a = (hf i).mk (f i) a},
    from λ x hx i, by simp only [ae_seq, hx, if_true],
  exact le_antisymm (le_trans (measure_mono (set.compl_subset_compl.mpr h_ss))
    (le_of_eq (measure_compl_ae_seq_set_eq_zero hf hp))) (zero_le _),
end

lemma ae_seq_eq_fun_ae [encodable ι] (hf : ∀ i, ae_measurable (f i) μ)
  (hp : ∀ᵐ x ∂μ, p x (λ n, f n x)) :
  ∀ᵐ (a : α) ∂μ, ∀ (i : ι), ae_seq hf p i a = f i a :=
begin
  have h_ss : {a : α | ¬∀ (i : ι), ae_seq hf p i a = f i a} ⊆ (ae_seq_set hf p)ᶜ,
    from λ x, mt (λ hx i, (ae_seq_eq_fun_of_mem_ae_seq_set hf hx i)),
  exact measure_mono_null h_ss (measure_compl_ae_seq_set_eq_zero hf hp),
end

lemma ae_seq_n_eq_fun_n_ae [encodable ι] (hf : ∀ i, ae_measurable (f i) μ)
  (hp : ∀ᵐ x ∂μ, p x (λ n, f n x)) (n : ι) :
  ae_seq hf p n =ᵐ[μ] f n:=
ae_all_iff.mp (ae_seq_eq_fun_ae hf hp) n

lemma supr [complete_lattice β] [encodable ι]
  (hf : ∀ i, ae_measurable (f i) μ) (hp : ∀ᵐ x ∂μ, p x (λ n, f n x)) :
  (⨆ n, ae_seq hf p n) =ᵐ[μ] ⨆ n, f n :=
begin
  simp_rw [filter.eventually_eq, ae_iff, supr_apply],
  have h_ss : ae_seq_set hf p ⊆ {a : α | (⨆ (i : ι), ae_seq hf p i a) = ⨆ (i : ι), f i a},
  { intros x hx,
    congr,
    exact funext (λ i, ae_seq_eq_fun_of_mem_ae_seq_set hf hx i), },
  exact measure_mono_null (set.compl_subset_compl.mpr h_ss)
    (measure_compl_ae_seq_set_eq_zero hf hp),
end

end ae_seq


import .eval_sqe_core .qfree_sqe .wf_sqe

open list

lemma hco_le_eq_of_ne_zero {m i k ks} :
k ≠ 0 → atom.unify m (atom.le i (k::ks)) =
  let m' := (m / (abs k)) in
  atom.le (m' * i) (znum.sign k :: map_mul m' ks) :=
begin intro h, simp [atom.unify], rw if_neg, apply h end

lemma hco_dvd_eq_of_ne_zero {m d i k ks} :
k ≠ 0 → atom.unify m (atom.dvd d i (k::ks)) =
  let m' := (m / k) in
  atom.dvd (m' * d) (m' * i) (1 :: map_mul m' ks) :=
begin intro h, simp [atom.unify], rw if_neg, apply h end

lemma hco_ndvd_eq_of_ne_zero {m d i k ks} :
k ≠ 0 → atom.unify m (atom.ndvd d i (k::ks)) =
  let m' := (m / k) in
  atom.ndvd (m' * d) (m' * i) (1 :: map_mul m' ks) :=
begin intro h, simp [atom.unify], rw if_neg, apply h end

lemma clcm_le_eq_of_ne_zero {i k : znum} {ks : list znum} :
  k ≠ 0 → coeffs_lcm (A' (atom.le i (k::ks))) = abs k :=
begin
  intro h, simp [coeffs_lcm, formula.atoms_dep_0,
     dep_0, formula.atoms, filter, head_coeff ],
  rw if_pos, simp [head_coeff, znum.lcms, znum.lcm, num.lcm,
    znum.abs_eq_abs_to_znum, znum.abs_one,
    num.gcd_one_right, num.div_one], apply h
end

lemma clcm_dvd_eq_of_ne_zero {d i k : znum} {ks : list znum} :
  k ≠ 0 → coeffs_lcm (A' (atom.dvd d i (k::ks))) = abs k :=
begin
  intro h, simp [coeffs_lcm, formula.atoms_dep_0,
     dep_0, formula.atoms, filter, head_coeff ],
  rw if_pos, simp [head_coeff, znum.lcms, znum.lcm, num.lcm,
    znum.abs_eq_abs_to_znum, znum.abs_one,
    num.gcd_one_right, num.div_one], apply h
end

lemma clcm_ndvd_eq {d i : znum} {ks : list znum} :
  coeffs_lcm (A' (atom.ndvd d i ks))
  = coeffs_lcm (A' (atom.dvd d i ks)) :=
begin
  cases ks with k ks; simp [coeffs_lcm, formula.atoms_dep_0,
     dep_0, formula.atoms, filter, head_coeff ],
  by_cases hkz : k = 0,
  { subst hkz, repeat {rw if_neg}, simp, simp, },
  { repeat {rw if_pos}, simp [head_coeff], assumption, assumption }
end

lemma eval_hco_le_iff {lcm z i : znum} {zs ks : list znum}
  (hpos : 0 < lcm) (hdvd : coeffs_lcm (A' atom.le i ks) ∣ lcm) :
  (A' (atom.unify lcm (atom.le i ks))).eval (lcm * z :: zs)
  ↔ (A' (atom.le i ks)).eval (z :: zs) :=
begin
  cases ks with k ks,
  { simp [atom.unify, eval_le] },
  {
    by_cases hkz : k = 0,
    { subst hkz, simp [atom.unify, eval_le, znum.dot_prod] },
    {
      rw clcm_le_eq_of_ne_zero hkz at hdvd,
      rw (hco_le_eq_of_ne_zero hkz), simp [eval_le, znum.dot_prod],
      apply calc
            lcm / abs k * i ≤ znum.sign k * (lcm * z) + znum.dot_prod (map_mul (lcm / abs k) ks) zs
          ↔ (lcm / abs k) * i ≤ (lcm / abs k) * (znum.dot_prod ks zs + k * z) :
            begin
              rw [mul_add, add_comm, znum.map_mul_dot_prod],
              have heq : znum.sign k * (lcm * z) = lcm / abs k * (k * z),
              { rw [(mul_assoc _ k _).symm, (znum.div_mul_comm _ _ _ hdvd),
                    (mul_comm lcm k), (znum.div_mul_comm _ _ _ _).symm,
                    znum.sign_eq_div_abs, mul_assoc], rw znum.abs_dvd },
              rw heq,
            end
      ... ↔ i ≤ znum.dot_prod ks zs + k * z :
            begin
              apply znum.mul_le_mul_iff_le_of_pos_left,
              apply znum.div_pos_of_pos_of_dvd hpos (abs_nonneg _) hdvd
            end
    }
  }
end

lemma eval_hco_dvd_iff {lcm z d i : znum} {zs ks}
  (hpos : lcm > 0) (hdvd : coeffs_lcm (A' atom.dvd d i ks) ∣ lcm) :
  (A' (atom.unify lcm (atom.dvd d i ks))).eval (lcm * z :: zs)
  ↔ (A' (atom.dvd d i ks)).eval (z :: zs) :=
begin
  cases ks with k ks,
  { simp [atom.unify, eval_dvd] },
  {
    by_cases hkz : k = 0,
    { subst hkz, simp [atom.unify, eval_dvd, znum.dot_prod] },
    {
      rw clcm_dvd_eq_of_ne_zero hkz at hdvd,
      rw (hco_dvd_eq_of_ne_zero hkz), simp [eval_dvd, znum.dot_prod],
      apply calc
            lcm / k * d ∣ lcm * z + (lcm / k * i + znum.dot_prod (map_mul (lcm / k) ks) zs)
          ↔ (lcm / k) * d ∣ (lcm / k) * (i + (znum.dot_prod ks zs + k * z)) :
            begin
              rw [mul_add, znum.map_mul_dot_prod,
                add_comm, mul_add, add_assoc],
              have heq : lcm / k * (k * z) = lcm * z,
              { rw [(mul_assoc _ _ _).symm, znum.div_mul_cancel],
                rw znum.abs_dvd at hdvd, apply hdvd },
              rw heq
            end
      ... ↔ d ∣ i + (znum.dot_prod ks zs + k * z) :
            begin
              apply mul_dvd_mul_iff_left, apply znum.div_nonzero,
              apply znum.nonzero_of_pos hpos,
              rw znum.abs_dvd at hdvd, apply hdvd,
            end
    }
  }
end

lemma eval_hco_ndvd_iff {m d i ks} {zs : list znum} :
 (A' (atom.unify m (atom.ndvd d i ks))).eval zs
 ↔ ¬ (A' (atom.unify m (atom.dvd d i ks))).eval zs :=
begin
  cases ks with k ks;
  simp [atom.unify, eval_dvd, eval_ndvd],
  by_cases hkz : k = 0,
  { subst hkz, repeat {rw if_pos},
    simp [eval_dvd, eval_ndvd], refl },
  { repeat {rw if_neg},
    simp [eval_dvd, eval_ndvd],
    assumption, assumption }
end

lemma coeffs_lcm_and (p q) :
  coeffs_lcm (p ∧' q) = znum.lcm (coeffs_lcm p) (coeffs_lcm q) :=
begin
  apply znum.lcms_distrib, apply list.equiv.trans,
  apply list.map_equiv_map_of_equiv,
  simp [formula.atoms_dep_0, formula.atoms], apply equiv.refl,
  simp [map_append, formula.atoms_dep_0],
  apply equiv.symm union_equiv_append,
end

lemma coeffs_lcm_or (p q) :
  coeffs_lcm (p ∨' q) = znum.lcm (coeffs_lcm p) (coeffs_lcm q) :=
begin
  apply znum.lcms_distrib, apply list.equiv.trans,
  apply list.map_equiv_map_of_equiv,
  simp [formula.atoms_dep_0, formula.atoms], apply equiv.refl,
  simp [map_append, formula.atoms_dep_0],
  apply equiv.symm union_equiv_append,
end

lemma hcso_prsv_1 (lcm z : znum) (zs) (hlcm1 : lcm > 0) (hdvd : lcm ∣ z) :
  ∀ (p : formula), nqfree p → formula.wf p → (has_dvd.dvd (coeffs_lcm p) lcm)
  → (formula.map (atom.unify lcm) p).eval (z::zs) → p.eval ((has_div.div z lcm)::zs)
| ⊤' hf hn _ h := begin simp [eval_true] end
| ⊥' hf hn _ h := begin exfalso, apply h end
| (A' (atom.le i ks)) hf hn hlcm2 h :=
  begin
    simp [formula.map] at h, have heq : z = lcm * (z / lcm),
    { rw [mul_comm, znum.div_mul_cancel hdvd] },
    rw heq at h, rw eval_hco_le_iff at h; try {assumption},
  end
| (A' (atom.dvd d i ks)) hf hn hlcm2 h :=
  begin
    simp [formula.map] at h, have heq : z = lcm * (z / lcm),
    { rw [mul_comm, znum.div_mul_cancel hdvd] }, rw heq at h,
    rewrite eval_hco_dvd_iff at h; try {assumption},
  end
| (A' (atom.ndvd d i ks)) hf hn hlcm2 h :=
  begin
    simp [formula.map] at h, have heq : z = lcm * (z / lcm),
    { rw [mul_comm, znum.div_mul_cancel hdvd] }, rw heq at h,
    rewrite eval_hco_ndvd_iff at h, rewrite eval_hco_dvd_iff at h,
    rw eval_ndvd', assumption, assumption,
    rw clcm_ndvd_eq at hlcm2, assumption,
  end
| (p ∧' q) hf hn hlcm2 h :=
  begin
    rewrite eval_and, cases hf with hfp hfq, cases hn with hnp hnq,
    unfold formula.map at h, cases h with hp hq, rewrite coeffs_lcm_and at hlcm2,
    apply and.intro; apply hcso_prsv_1; try {assumption},
    apply dvd.trans _ hlcm2, apply znum.dvd_lcm_left,
    apply dvd.trans _ hlcm2, apply znum.dvd_lcm_right,
  end
  | (p ∨' q) hf hn hlcm2 h :=
  begin
    rewrite coeffs_lcm_or at hlcm2, rewrite eval_or,
    cases hf with hfp hfq, cases hn with hnp hnq,
    unfold formula.map at h, rewrite eval_or at h, cases h with hp hq,
    apply or.inl, apply hcso_prsv_1; try {assumption},
    apply dvd.trans _ hlcm2, apply znum.dvd_lcm_left,
    apply or.inr, apply hcso_prsv_1; try {assumption},
    apply dvd.trans _ hlcm2, apply znum.dvd_lcm_right
  end
| (¬' p) hf hn _ h := by cases hf
| (∃' p) hf hn _ h := by cases hf

lemma hcso_prsv_2 (lcm z : znum) (zs) (hpos : lcm > 0) :
  ∀ (p : formula), nqfree p → formula.wf p → has_dvd.dvd (coeffs_lcm p) lcm
  → p.eval (z::zs) → (formula.map (atom.unify lcm) p).eval ((lcm * z)::zs)
| ⊤' hf hn hdvd h := trivial
| ⊥' hf hn hdvd h := by cases h
| (A' (atom.le i ks)) hf hn hdvd h :=
  begin
    unfold formula.map, rewrite eval_hco_le_iff,
    apply h, apply hpos, apply hdvd
  end
| (A' (atom.dvd d i ks)) hf hn hdvd h :=
  begin
    unfold formula.map, rewrite eval_hco_dvd_iff,
    apply h, apply hpos, apply hdvd
  end
| (A' (atom.ndvd d i ks)) hf hn hdvd h :=
  begin
    unfold formula.map, rw [eval_hco_ndvd_iff, eval_hco_dvd_iff],
    apply h, apply hpos, rw clcm_ndvd_eq at hdvd, apply hdvd
  end
| (p ∧' q) hf hn hdvd h :=
  begin
    unfold formula.map, rewrite eval_and,
    rewrite eval_and at h, cases h with hp hq,
    cases hn with hnp hnq, cases hf with hfp hfq,
    rewrite coeffs_lcm_and at hdvd, apply and.intro;
    apply hcso_prsv_2; try {assumption},
    apply dvd.trans _ hdvd, apply znum.dvd_lcm_left,
    apply dvd.trans _ hdvd, apply znum.dvd_lcm_right
  end
| (p ∨' q) hf hn hdvd h :=
  begin
    unfold formula.map, rewrite eval_or, rewrite eval_or at h,
    cases hn with hnp hnq, cases hf with hfp hfq,
    rewrite coeffs_lcm_or at hdvd,
    cases h with hp hq, apply or.inl,
    apply hcso_prsv_2; try {assumption},
    apply dvd.trans _ hdvd, apply znum.dvd_lcm_left,
    apply or.inr, apply hcso_prsv_2; try {assumption},
    apply dvd.trans _ hdvd, apply znum.dvd_lcm_right
  end
| (¬' p) hf hn hdvd h := by cases hf
| (∃' p) hf hn hdvd h := by cases hf

lemma coeffs_lcm_pos (p) :
  coeffs_lcm p > 0 :=
begin
  apply znum.lcms_pos,
  intros z hz, rewrite list.mem_map at hz,
  cases hz with a ha, cases ha with ha1 ha2,
  subst ha2, unfold formula.atoms_dep_0 at ha1,
  rw (@mem_filter _ dep_0 _ a (formula.atoms p)) at ha1,
  apply ha1^.elim_right
end

lemma hcso_prsv :
∀ (p : formula) (hf : nqfree p) (hn : formula.wf p) (bs : list znum),
(∃ (b : znum), (p.unify).eval (b :: bs)) ↔ ∃ (b : znum), p.eval (b :: bs) :=
begin
  intros p hf hn bs, apply iff.intro;
  intro h; cases h with z hz,
  { unfold formula.unify at hz, rewrite eval_and at hz,
    existsi (has_div.div z (coeffs_lcm p)),
    cases hz with hz1 hz2, apply hcso_prsv_1;
    try {assumption}, rewrite eval_dvd at hz1,
    rewrite zero_add at hz1, apply coeffs_lcm_pos,
    simp [eval_dvd, znum.dot_prod] at hz1,
    apply hz1, apply dvd_refl },
  { existsi (coeffs_lcm p * z), unfold formula.unify,
    rewrite eval_and, apply and.intro,
    rewrite eval_dvd, rewrite zero_add,
    simp [znum.dot_prod], apply hcso_prsv_2;
    try {assumption}, apply coeffs_lcm_pos,
    apply dvd_refl }
end

lemma unified_sign {k} :
  znum.sign k = -1 ∨ znum.sign k = 0 ∨ znum.sign k = 1 :=
begin
  cases lt_trichotomy k 0 with h h,
  { rw znum.sign_eq_neg_one_of_neg h, apply or.inl rfl },
  cases h with h h,
  { rw znum.sign_eq_zero_iff_zero, apply or.inr (or.inl h) },
  { rw znum.sign_eq_one_of_pos h, apply or.inr (or.inr rfl) },
end

lemma unified_atom_hco {k} :
  ∀ {a}, (atom.unify k a).unified
| (atom.le i []) := or.inr (or.inl rfl)
| (atom.ndvd d i []) := or.inr (or.inl rfl)
| (atom.le i (k::ks)) :=
  begin
    by_cases hkz : k = 0,
    { subst hkz, apply or.inr (or.inl rfl) },
    { rw hco_le_eq_of_ne_zero hkz, apply unified_sign }
  end
| (atom.dvd d i []) := or.inr (or.inl rfl)
| (atom.dvd d i (k::ks)) :=
  begin
    by_cases hkz : k = 0,
    { subst hkz, apply or.inr (or.inl rfl) },
    { rw hco_dvd_eq_of_ne_zero hkz, apply or.inr (or.inr rfl) }
  end
| (atom.ndvd d i (k::ks)) :=
  begin
    by_cases hkz : k = 0,
    { subst hkz, apply or.inr (or.inl rfl) },
    { rw hco_ndvd_eq_of_ne_zero hkz, apply or.inr (or.inr rfl) }
  end

lemma unified_formula.map_hco {k} :
  ∀ p, nqfree p → unified (formula.map (atom.unify k) p)
| ⊤' hf a hm := by cases hm
| ⊥' hf a hm := by cases hm
| (A' a') hf a hm :=
  begin
   simp [formula.atoms, formula.map] at hm, subst hm,
   apply unified_atom_hco,
  end
| (p ∧' q) hf a hm :=
  begin
    cases hf with hfp hfq, simp [formula.atoms, formula.map] at hm,
    cases hm, apply unified_formula.map_hco p hfp _ hm,
    apply unified_formula.map_hco q hfq _ hm,
  end
| (p ∨' q) hf a hm :=
  begin
    cases hf with hfp hfq, simp [formula.atoms, formula.map] at hm,
    cases hm, apply unified_formula.map_hco p hfp _ hm,
    apply unified_formula.map_hco q hfq _ hm,
  end
| (¬' p) hf a hm := by cases hf
| (∃' p) hf a hm := by cases hf

lemma unified_hcso :
  ∀ p, nqfree p → unified p.unify :=
begin
  intros p hf, simp [unified, formula.atoms, formula.unify],
  constructor, apply (or.inr (or.inr rfl)),
  apply unified_formula.map_hco _ hf
end

lemma eval_sqe :
  ∀ {p : formula}, nqfree p → formula.wf p
  → ∀ {bs : list znum}, (sqe p).eval bs ↔ ∃ (b : znum), p.eval (b :: bs) :=
begin
  intros p hf hn bs, unfold sqe,
  rewrite eval_sqe_core_iff,
  apply hcso_prsv p hf hn bs,
  apply nqfree_unify hf,
  apply formula.wf_hcso hn,
  apply unified_hcso, apply hf
end


import category_theory.sites.sheaf
import category_theory.sites.sheafification

namespace category_theory.presheaf

open category_theory

universes w v u
variables {C : Type u} [category.{v} C] (J : grothendieck_topology C)
variables {D : Type w} [category.{max v u} D]

lemma is_sheaf_of_iso {F G : Cᵒᵖ ⥤ D} (η : F ≅ G) (hG : is_sheaf J G) : is_sheaf J F :=
begin
  intros T X S hS,
  let e : F ⋙ coyoneda.obj (opposite.op T) ≅ G ⋙ coyoneda.obj (opposite.op T) :=
    iso_whisker_right η _,
  apply presieve.is_sheaf_for_iso e.symm,
  apply hG _ _ hS,
end

variables [concrete_category.{max v u} D]
variables [∀ (P : Cᵒᵖ ⥤ D) (X : C) (S : J.cover X), limits.has_multiequalizer (S.index P)]
variables [limits.preserves_limits (forget D)]
variables [∀ (X : C), limits.has_colimits_of_shape (J.cover X)ᵒᵖ D]
variables [∀ (X : C), limits.preserves_colimits_of_shape (J.cover X)ᵒᵖ (forget D)]
variables [reflects_isomorphisms (forget D)]

lemma _root_.category_theory.grothendieck_topology.is_iso_sheafify_lift_of_is_iso {F G : Cᵒᵖ ⥤ D}
  (η : F ⟶ G) (hG : is_sheaf J G) [h : is_iso η] : is_iso (J.sheafify_lift η hG) :=
begin
  have hF : is_sheaf J F,
  { apply is_sheaf_of_iso _ (as_iso η) hG },
  constructor,
  use inv η ≫ J.to_sheafify _,
  split,
  { apply J.sheafify_hom_ext _ _,
    { exact grothendieck_topology.plus.is_sheaf_plus_plus J F },
    simp only [← category.assoc, J.to_sheafify_sheafify_lift, is_iso.hom_inv_id,
      category.id_comp, category.comp_id] },
  { simp only [category.assoc, J.to_sheafify_sheafify_lift, is_iso.inv_hom_id] }
end

end category_theory.presheaf

namespace category_theory

namespace Sheaf

variables {C : Type*} [category C]
variables {J : grothendieck_topology C}
variables {A : Type*} [category A]

@[simp] lemma hom.id_val (X : Sheaf J A) : Sheaf.hom.val (𝟙 X) = 𝟙 X.val := rfl

lemma hom.comp_val {X Y Z : Sheaf J A} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (f ≫ g).val = f.val ≫ g.val := rfl

@[simps]
def iso.mk (X Y : Sheaf J A) (e : X.val ≅ Y.val) : X ≅ Y :=
⟨⟨e.hom⟩, ⟨e.inv⟩, by { ext1, simp }, by { ext1, simp }⟩

end Sheaf

end category_theory