import data.nat.prime data.set.finite

/-!
# Dirichlet's theorem on arithmetic progressions

For any `d a : ℕ` coprime with `0 < d`, there exists
  infinitely many primes of form `kd + a` for some `k : ℕ`.
For now, we will just state a variant using `nat.mod`, thus assuming `a < d`.
However, we will not prove this theorem and leave it with a `sorry` proof.

The proofs are pretty much copied from the one given in
  the file `data/nat/prime.lean` for infinitude of primes.
-/

namespace IMOSL
namespace extra

variables {d a : ℕ} (h : a < d) (h0 : a.coprime d)
include h h0

theorem exists_infinite_primes_mod_eq (n : ℕ) : ∃ p : ℕ, n < p ∧ p.prime ∧ p % d = a :=
  sorry

theorem not_bdd_above_set_of_primes_mod_eq : ¬bdd_above {p : ℕ | p.prime ∧ p % d = a} :=
begin
  rw not_bdd_above_iff; intros n,
  rcases exists_infinite_primes_mod_eq h h0 n with ⟨p, h1, h2⟩,
  exact ⟨p, h2, h1⟩
end

theorem infinite_set_of_primes_mod_eq : {p : ℕ | p.prime ∧ p % d = a}.infinite :=
  set.infinite_of_not_bdd_above (not_bdd_above_set_of_primes_mod_eq h h0)

end extra
end IMOSL


import Smt.Tactics

set_option trace.Smt.debug true

theorem verum : True := by
  smt
  simp_all

theorem falsum : ¬False := by
  smt
  simp_all

theorem triv (p : Prop) : p → p := by
  smt
  simp_all

theorem triv': ∀ (p : Prop), ∀ _ : p, p := by
  smt
  intro p
  simp_all

theorem triv'' (p : Prop) : ¬p → ¬p := by
  smt
  simp_all

theorem modus_ponens (p q : Prop) : p → (p → q) → q := by
  smt
  simp_all

theorem modus_ponens' (p q : Prop) (hp : p) (hpq : p → q) : q := by
  smt [hp, hpq]
  simp_all

theorem modus_tollens (p q : Prop) : ¬q → (p → q) → ¬p := by
  smt
  intro hnq hpq hp
  simp_all

theorem hypothetical_syllogism (p q r : Prop) : (p → q) → (q → r) → p → r := by
  smt
  simp_all

theorem disjunctive_syllogism (p q : Prop) : p ∨ q → ¬p → q := by
  smt
  intro hpq hnp
  simp_all

theorem addition (p q : Prop) : p → p ∨ q := by
  smt
  simp_all

theorem simplification (p q : Prop) : p ∧ q → p := by
  smt
  simp_all

theorem conjunction (p q : Prop) : p → q → p ∧ q := by
  smt
  simp_all

theorem resolution (p q r : Prop) : p ∨ q → ¬p ∨ r → q ∨ r := by
  smt
  intro hpq
  intro hnpr
  induction hpq <;> simp_all

theorem prop_ext (p q : Prop) : (p ↔ q) → p = q := by
  smt
  simp_all

-- UF Axioms (apply to all sorts, not just Prop)

theorem refl (p : Prop) : p = p := by
  smt
  simp_all

theorem symm (p q : Prop) : p = q → q = p := by
  smt
  simp_all

theorem trans (p q r : Prop) : p = q → q = r → p = r := by
  smt
  simp_all

theorem cong (p q : Prop) (f : Prop → Prop) : p = q → f p = f q := by
  smt
  simp_all

theorem comm (f : Prop → Prop → Prop) (p q : Prop) : f p q = f q p := by
  smt
  admit

theorem assoc (f : Prop → Prop → Prop) (p q r : Prop) :
  f p (f q r) = f (f p q) r := by
  smt
  admit

-- LIA

theorem lia1 : Nat.zero + Nat.succ Nat.zero = Nat.succ Nat.zero := by
  smt
  simp_all

theorem lia1' : 0 + 1 = 1 := by
  smt
  simp_all

theorem lia2 (x y : Int) (f : Int → Int) : x = y → f x = f y := by
  smt
  simp_all

-- In-Progress
/-
theorem lia3 : 1 - 3 = 0 := by
  smt
  simp_all

theorem test : ∃ (p : Prop), p := by
  smt
  exact Exists.intro True True.intro
-/


/-
Copyright (c) 2022 Yaël Dillies, Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Kexing Ying
-/
import mathlib.algebra.big_operators.basic
import mathlib.pmf
import probability.ident_distrib
import mathlib.probability.independence

/-!
# Sequences of iid Bernoulli random variables

This file defines sequences of independent `p`-Bernoulli random variables and proves that the
complement of a sequence of independent Bernoulli random variables, union/intersection of two
independent sequences of independent Bernoulli random variables, are themselves sequences of
independent Bernoulli random variables.

## Main declarations

* `probability_theory.bernoulli_seq`: Typeclass for a sequence ``
-/

open measure_theory
open_locale measure_theory probability_theory ennreal nnreal

namespace probability_theory
variables {α Ω : Type*} [measurable_space Ω]

/-- We say a `set α`-valued random is a sequence of iid Bernoulli random variables with parameter
`p` if `p ≤ 1`, the `a` projections (for `a : α`) are independent and are `p`-Bernoulli distributed.
-/
@[protect_proj]
class bernoulli_seq (X : Ω → set α) (p : out_param ℝ≥0) (μ : measure Ω . volume_tac) : Prop :=
(le_one [] : p ≤ 1)
(Indep_fun [] : Indep_fun infer_instance (λ a ω, a ∈ X ω) μ)
(map [] : ∀ a, measure.map (λ ω, a ∈ X ω) μ = (pmf.bernoulli' p le_one).to_measure)

variables (X Y : Ω → set α) (μ : measure Ω) {p q : ℝ≥0} [bernoulli_seq X p μ] [bernoulli_seq Y q μ]
include X p

namespace bernoulli_seq

protected lemma ne_zero [nonempty α] : μ ≠ 0 :=
nonempty.elim ‹_› $ λ a h, (pmf.bernoulli' p $ bernoulli_seq.le_one X μ).to_measure_ne_zero $
  by rw [←bernoulli_seq.map X _ a, h, measure.map_zero]

protected lemma ae_measurable (a : α) : ae_measurable (λ ω, a ∈ X ω) μ :=
begin
  classical,
  have : (pmf.bernoulli' p $ bernoulli_seq.le_one X μ).to_measure ≠ 0 := ne_zero.ne _,
  rw [←bernoulli_seq.map X _ a, measure.map] at this,
  refine (ne.dite_ne_right_iff $ λ hX, _).1 this,
  rw measure.mapₗ_ne_zero_iff hX.measurable_mk,
  haveI : nonempty α := ⟨a⟩,
  exact bernoulli_seq.ne_zero X _,
end

@[simp] protected lemma null_measurable_set (a : α) : null_measurable_set {ω | a ∈ X ω} μ :=
begin
  rw [(by { ext, simp } : {ω | a ∈ X ω} = (λ ω, a ∈ X ω) ⁻¹' {true})],
  exact (bernoulli_seq.ae_measurable X _ a).null_measurable_set_preimage
    measurable_space.measurable_set_top
end

protected lemma ident_distrib (a j : α) : ident_distrib (λ ω, a ∈ X ω) (λ ω, X ω j) μ μ :=
{ ae_measurable_fst := bernoulli_seq.ae_measurable _ _ _,
  ae_measurable_snd := bernoulli_seq.ae_measurable _ _ _,
  map_eq := (bernoulli_seq.map _ _ _).trans (bernoulli_seq.map _ _ _).symm }

@[simp] lemma meas_apply (a : α) : μ {ω | a ∈ X ω} = p :=
begin
  rw [(_ : {ω | a ∈ X ω} = (λ ω, a ∈ X ω) ⁻¹' {true}),
    ← measure.map_apply_of_ae_measurable (bernoulli_seq.ae_measurable X μ a)
      measurable_space.measurable_set_top],
  { simp [bernoulli_seq.map X μ] },
  { ext ω,
    simp }
end

variables [is_probability_measure (μ : measure Ω)]

protected lemma meas [fintype α] (s : finset α) :
  μ {ω | {a | a ∈ X ω} = s} = p ^ s.card * (1 - p) ^ (fintype.card α - s.card) :=
begin
  classical,
  simp_rw [set.ext_iff, set.set_of_forall],
  rw [(bernoulli_seq.Indep_fun X μ).meas_Inter, ←s.prod_mul_prod_compl,
    finset.prod_eq_pow_card _ _ (p : ℝ≥0∞), finset.prod_eq_pow_card _ _ (1 - p : ℝ≥0∞),
    finset.card_compl],
  { rintro a hi,
    rw finset.mem_compl at hi,
    simp only [hi, ←set.compl_set_of, null_measurable_set.prob_compl_eq_one_sub, set.mem_set_of_eq,
      finset.mem_coe, iff_false, bernoulli_seq.null_measurable_set, meas_apply] },
  { rintro a hi,
    simp only [hi, set.mem_set_of_eq, finset.mem_coe, iff_true, meas_apply] },
  rintro a,
  by_cases a ∈ s,
  { simp only [*, set.mem_set_of_eq, finset.mem_coe, iff_true],
    exact ⟨{true}, trivial, by { ext, simp }⟩ },
  { simp only [*, set.mem_set_of_eq, finset.mem_coe, iff_false],
    exact ⟨{false}, trivial, by { ext, simp }⟩ }
end

/-- The complement of a sequence of independent `p`-Bernoulli random variables is a sequence of
independent `1 - p`-Bernoulli random variables. -/
instance compl : bernoulli_seq (λ ω, (X ω)ᶜ) (1 - p) μ :=
{ le_one := tsub_le_self,
  Indep_fun :=
  begin
    simp only [Indep_fun, set.mem_compl_iff, measurable_space.comap_not],
    exact bernoulli_seq.Indep_fun X _,
  end,
  map := λ a, begin
    have : measurable not := λ _ _, trivial,
    simp only [set.mem_compl_iff],
    rw [←this.ae_measurable.map_map_of_ae_measurable (bernoulli_seq.ae_measurable X μ _),
      bernoulli_seq.map, pmf.map_to_measure _ this, pmf.map_not_bernoulli'],
  end }

/-- The intersection of a sequence of independent `p`-Bernoulli and `q`-Bernoulli random variables
is a sequence of independent `p * q`-Bernoulli random variables. -/
protected lemma inter (h : indep_fun X Y μ) : bernoulli_seq (λ ω, X ω ∩ Y ω) (p * q) μ :=
{ le_one := mul_le_one' (bernoulli_seq.le_one X μ) (bernoulli_seq.le_one Y μ),
  Indep_fun :=
  begin
    refine Indep_set.Indep_comap ((Indep_set_iff_measure_Inter_eq_prod $ λ i, _).2 _),
    refine measurable_set.inter _ _,
    sorry, -- needs refactor of `probability.independence`
    sorry, -- needs refactor of `probability.independence`
    refine λ s, _,
    -- We abused defeq using `Indep_set.Indep_comap`, so we fix it here
    change μ (⋂ i ∈ s, {ω | X ω i} ∩ {ω | Y ω i}) = s.prod (λ i, μ ({ω | X ω i} ∩ {ω | Y ω i})),
    simp_rw set.Inter_inter_distrib,
    rw [h, bernoulli_seq.Indep_fun X μ, bernoulli_seq.Indep_fun Y μ, ←finset.prod_mul_distrib],
    refine finset.prod_congr rfl (λ i hi, (h _ _ _ _).symm),
    sorry, -- needs refactor of `probability.independence`
    sorry, -- needs refactor of `probability.independence`
    sorry, -- needs refactor of `probability.independence`
    sorry, -- needs refactor of `probability.independence`
    sorry, -- needs refactor of `probability.independence`
    sorry, -- needs refactor of `probability.independence`
  end,
  map := begin
    rintro a,
    sorry
  end }

/-- The union of a sequence of independent `p`-Bernoulli random variables is a sequence of
independent `1 - p`-Bernoulli random variables. -/
protected lemma union (h : indep_fun X Y μ) : bernoulli_seq (λ ω, X ω ∪ Y ω) (p + q - p * q) μ :=
begin
  haveI := bernoulli_seq.inter (λ ω, (X ω)ᶜ) (λ ω, (Y ω)ᶜ) μ _,
  convert bernoulli_seq.compl (λ ω, (X ω)ᶜ ∩ (Y ω)ᶜ) μ using 1,
  simp only [set.compl_inter, compl_compl],
  rw [mul_tsub, mul_one, tsub_tsub, tsub_tsub_cancel_of_le, tsub_mul, one_mul,
    add_tsub_assoc_of_le (mul_le_of_le_one_left' $ bernoulli_seq.le_one X μ)],
  { exact (add_le_add_left (mul_le_of_le_one_right' $ bernoulli_seq.le_one Y μ) _).trans_eq
      (add_tsub_cancel_of_le $ bernoulli_seq.le_one X μ) },
  rwa [indep_fun, measurable_space.comap_compl, measurable_space.comap_compl]; exact λ _ _, trivial,
end

end bernoulli_seq
end probability_theory


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

/-- A max-heap data structure. -/
structure BinaryHeap (α) (lt : α → α → Bool) where
  arr : Array α

namespace BinaryHeap

/-- Core operation for binary heaps, expressed directly on arrays.
Given an array which is a max-heap, push item `i` down to restore the max-heap property. -/
def heapifyDown (lt : α → α → Bool) (a : Array α) (i : Fin a.size) :
  {a' : Array α // a'.size = a.size} :=
  let left := 2 * i.1 + 1
  let right := left + 1
  have left_le : i ≤ left := Nat.le_trans
    (by rw [Nat.succ_mul, Nat.one_mul]; exact Nat.le_add_left i i)
    (Nat.le_add_right ..)
  have right_le : i ≤ right := Nat.le_trans left_le (Nat.le_add_right ..)
  have i_le : i ≤ i := Nat.le_refl _
  have j : {j : Fin a.size // i ≤ j} := if h : left < a.size then
    if lt (a.get i) (a.get ⟨left, h⟩) then ⟨⟨left, h⟩, left_le⟩ else ⟨i, i_le⟩ else ⟨i, i_le⟩
  have j := if h : right < a.size then
    if lt (a.get j) (a.get ⟨right, h⟩) then ⟨⟨right, h⟩, right_le⟩ else j else j
  if h : i.1 = j then ⟨a, rfl⟩ else
    let a' := a.swap i j
    let j' := ⟨j, by rw [a.size_swap i j]; exact j.1.2⟩
    have : a'.size - j < a.size - i := by
      rw [a.size_swap i j]; sorry
    let ⟨a₂, h₂⟩ := heapifyDown lt a' j'
    ⟨a₂, h₂.trans (a.size_swap i j)⟩
termination_by _ => a.size - i
decreasing_by assumption

@[simp] theorem size_heapifyDown (lt : α → α → Bool) (a : Array α) (i : Fin a.size) :
  (heapifyDown lt a i).1.size = a.size := (heapifyDown lt a i).2

/-- Core operation for binary heaps, expressed directly on arrays.
Construct a heap from an unsorted array, by heapifying all the elements. -/
def mkHeap (lt : α → α → Bool) (a : Array α) : {a' : Array α // a'.size = a.size} :=
  let rec loop : (i : Nat) → (a : Array α) → i ≤ a.size → {a' : Array α // a'.size = a.size}
  | 0, a, _ => ⟨a, rfl⟩
  | i+1, a, h =>
    let h := Nat.lt_of_succ_le h
    let a' := heapifyDown lt a ⟨i, h⟩
    let ⟨a₂, h₂⟩ := loop i a' ((heapifyDown ..).2.symm ▸ Nat.le_of_lt h)
    ⟨a₂, h₂.trans a'.2⟩
  loop (a.size / 2) a sorry

@[simp] theorem size_mkHeap (lt : α → α → Bool) (a : Array α) (i : Fin a.size) :
  (mkHeap lt a).1.size = a.size := (mkHeap lt a).2

/-- Core operation for binary heaps, expressed directly on arrays.
Given an array which is a max-heap, push item `i` up to restore the max-heap property. -/
def heapifyUp (lt : α → α → Bool) (a : Array α) (i : Fin a.size) :
  {a' : Array α // a'.size = a.size} :=
if i0 : i.1 = 0 then ⟨a, rfl⟩ else
  have : (i.1 - 1) / 2 < i := sorry
  let j := ⟨(i.1 - 1) / 2, Nat.lt_trans this i.2⟩
  if lt (a.get j) (a.get i) then
    let a' := a.swap i j
    let ⟨a₂, h₂⟩ := heapifyUp lt a' ⟨j.1, by rw [a.size_swap i j]; exact j.2⟩
    ⟨a₂, h₂.trans (a.size_swap i j)⟩
  else ⟨a, rfl⟩
termination_by _ => i.1
decreasing_by assumption

@[simp] theorem size_heapifyUp (lt : α → α → Bool) (a : Array α) (i : Fin a.size) :
  (heapifyUp lt a i).1.size = a.size := (heapifyUp lt a i).2

/-- `O(1)`. Build a new empty heap. -/
def empty (lt) : BinaryHeap α lt := ⟨#[]⟩

instance (lt) : Inhabited (BinaryHeap α lt) := ⟨empty _⟩
instance (lt) : EmptyCollection (BinaryHeap α lt) := ⟨empty _⟩

/-- `O(1)`. Build a one-element heap. -/
def singleton (lt) (x : α) : BinaryHeap α lt := ⟨#[x]⟩

/-- `O(1)`. Get the number of elements in a `BinaryHeap`. -/
def size {lt} (self : BinaryHeap α lt) : Nat := self.1.size

/-- `O(1)`. Get an element in the heap by index. -/
def get {lt} (self : BinaryHeap α lt) (i : Fin self.size) : α := self.1.get i

/-- `O(log n)`. Insert an element into a `BinaryHeap`, preserving the max-heap property. -/
def insert {lt} (self : BinaryHeap α lt) (x : α) : BinaryHeap α lt where
  arr := let n := self.size;
    heapifyUp lt (self.1.push x) ⟨n, by rw [Array.size_push]; apply Nat.lt_succ_self⟩

@[simp] theorem size_insert {lt} (self : BinaryHeap α lt) (x : α) :
  (self.insert x).size = self.size + 1 := by
  simp [insert, size, size_heapifyUp]

/-- `O(1)`. Get the maximum element in a `BinaryHeap`. -/
def max {lt} (self : BinaryHeap α lt) : Option α := self.1.get? 0

/-- Auxiliary for `popMax`. -/
def popMaxAux {lt} (self : BinaryHeap α lt) : {a' : BinaryHeap α lt // a'.size = self.size - 1} :=
  match e: self.1.size with
  | 0 => ⟨self, by simp [size, e]⟩
  | n+1 =>
    have h0 := by rw [e]; apply Nat.succ_pos
    have hn := by rw [e]; apply Nat.lt_succ_self
    if hn0 : 0 < n then
      let a := self.1.swap ⟨0, h0⟩ ⟨n, hn⟩ |>.pop
      ⟨⟨heapifyDown lt a ⟨0, sorry⟩⟩,
        by simp [size]⟩
    else
      ⟨⟨self.1.pop⟩, by simp [size]⟩

/-- `O(log n)`. Remove the maximum element from a `BinaryHeap`.
Call `max` first to actually retrieve the maximum element. -/
def popMax {lt} (self : BinaryHeap α lt) : BinaryHeap α lt := self.popMaxAux

@[simp] theorem size_popMax {lt} (self : BinaryHeap α lt) :
  self.popMax.size = self.size - 1 := self.popMaxAux.2

/-- `O(log n)`. Return and remove the maximum element from a `BinaryHeap`. -/
def extractMax {lt} (self : BinaryHeap α lt) : Option α × BinaryHeap α lt :=
  (self.max, self.popMax)

theorem size_pos_of_max {lt} {self : BinaryHeap α lt} (e : self.max = some x) : 0 < self.size :=
  Decidable.of_not_not fun h: ¬ 0 < self.1.size => by simp [BinaryHeap.max, Array.get?, h] at e

/-- `O(log n)`. Equivalent to `extractMax (self.insert x)`, except that extraction cannot fail. -/
def insertExtractMax {lt} (self : BinaryHeap α lt) (x : α) : α × BinaryHeap α lt :=
  match e: self.max with
  | none => (x, self)
  | some m =>
    if lt x m then
      let a := self.1.set ⟨0, size_pos_of_max e⟩ x
      (m, ⟨heapifyDown lt a ⟨0, by simp; exact size_pos_of_max e⟩⟩)
    else (x, self)

/-- `O(log n)`. Equivalent to `(self.max, self.popMax.insert x)`. -/
def replaceMax {lt} (self : BinaryHeap α lt) (x : α) : Option α × BinaryHeap α lt :=
  match e: self.max with
  | none => (none, ⟨self.1.push x⟩)
  | some m =>
    let a := self.1.set ⟨0, size_pos_of_max e⟩ x
    (some m, ⟨heapifyDown lt a ⟨0, by simp; exact size_pos_of_max e⟩⟩)

/-- `O(log n)`. Replace the value at index `i` by `x`. Assumes that `x ≤ self.get i`. -/
def decreaseKey {lt} (self : BinaryHeap α lt) (i : Fin self.size) (x : α) : BinaryHeap α lt where
  arr := heapifyDown lt (self.1.set i x) ⟨i, by rw [self.1.size_set]; exact i.2⟩

/-- `O(log n)`. Replace the value at index `i` by `x`. Assumes that `self.get i ≤ x`. -/
def increaseKey {lt} (self : BinaryHeap α lt) (i : Fin self.size) (x : α) : BinaryHeap α lt where
  arr := heapifyUp lt (self.1.set i x) ⟨i, by rw [self.1.size_set]; exact i.2⟩

end BinaryHeap

/-- `O(n)`. Convert an unsorted array to a `BinaryHeap`. -/
def Array.toBinaryHeap (lt : α → α → Bool) (a : Array α) : BinaryHeap α lt where
  arr := BinaryHeap.mkHeap lt a

/-- `O(n log n)`. Sort an array using a `BinaryHeap`. -/
@[specialize] def Array.heapSort (a : Array α) (lt : α → α → Bool) : Array α :=
  let gt y x := lt x y
  let rec loop (a : BinaryHeap α gt) (out : Array α) : Array α :=
    match e:a.max with
    | none => out
    | some x =>
      have : a.popMax.size < a.size := by
        simp; exact Nat.sub_lt (BinaryHeap.size_pos_of_max e) Nat.zero_lt_one
      loop a.popMax (out.push x)
  loop (a.toBinaryHeap gt) #[]
termination_by _ => a.size
decreasing_by assumption

attribute [simp] Array.heapSort.loop
#check Array.heapSort.loop._eq_1

attribute [simp] BinaryHeap.heapifyDown


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

universes u v

namespace Mathlib

/-!
# Endofunctors as a monoidal category.

We give the monoidal category structure on `C ⥤ C`,
and show that when `C` itself is monoidal, it embeds via a monoidal functor into `C ⥤ C`.

## TODO

Can we use this to show coherence results, e.g. a cheap proof that `λ_ (𝟙_ C) = ρ_ (𝟙_ C)`?
I suspect this is harder than is usually made out.
-/

namespace category_theory

/--
The category of endofunctors of any category is a monoidal category,
with tensor product given by composition of functors
(and horizontal composition of natural transformations).
-/
def endofunctor_monoidal_category (C : Type u) [category C] : monoidal_category (C ⥤ C) :=
  monoidal_category.mk (fun (F G : C ⥤ C) => F ⋙ G)
    (fun (F G F' G' : C ⥤ C) (α : F ⟶ G) (β : F' ⟶ G') => α ◫ β) 𝟭
    (fun (F G H : C ⥤ C) => functor.associator F G H) (fun (F : C ⥤ C) => functor.left_unitor F)
    fun (F : C ⥤ C) => functor.right_unitor F

/--
Tensoring on the right gives a monoidal functor from `C` into endofunctors of `C`.
-/
@[simp] theorem tensoring_right_monoidal_to_lax_monoidal_functor_to_functor (C : Type u)
    [category C] [monoidal_category C] :
    lax_monoidal_functor.to_functor
          (monoidal_functor.to_lax_monoidal_functor (tensoring_right_monoidal C)) =
        monoidal_category.tensoring_right C :=
  Eq.refl
    (lax_monoidal_functor.to_functor
      (monoidal_functor.to_lax_monoidal_functor (tensoring_right_monoidal C)))

end Mathlib


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison
-/
import category_theory.limits.shapes.types
import topology.sheaves.presheaf_of_functions
import topology.sheaves.sheaf_condition.unique_gluing

/-!
# Sheaf conditions for presheaves of (continuous) functions.

We show that
* `Top.presheaf.to_Type_is_sheaf`: not-necessarily-continuous functions into a type form a sheaf
* `Top.presheaf.to_Types_is_sheaf`: in fact, these may be dependent functions into a type family

For
* `Top.sheaf_to_Top`: continuous functions into a topological space form a sheaf
please see `topology/sheaves/local_predicate.lean`, where we set up a general framework
for constructing sub(pre)sheaves of the sheaf of dependent functions.

## Future work
Obviously there's more to do:
* sections of a fiber bundle
* various classes of smooth and structure preserving functions
* functions into spaces with algebraic structure, which the sections inherit
-/

open category_theory
open category_theory.limits
open topological_space
open topological_space.opens

universe u

noncomputable theory

variables (X : Top.{u})

open Top

namespace Top.presheaf

/--
We show that the presheaf of functions to a type `T`
(no continuity assumptions, just plain functions)
form a sheaf.

In fact, the proof is identical when we do this for dependent functions to a type family `T`,
so we do the more general case.
-/
lemma to_Types_is_sheaf (T : X → Type u) : (presheaf_to_Types X T).is_sheaf :=
is_sheaf_of_is_sheaf_unique_gluing_types _ $ λ ι U sf hsf,
-- We use the sheaf condition in terms of unique gluing
-- U is a family of open sets, indexed by `ι` and `sf` is a compatible family of sections.
-- In the informal comments below, I'll just write `U` to represent the union.
begin
  -- Our first goal is to define a function "lifted" to all of `U`.
  -- We do this one point at a time. Using the axiom of choice, we can pick for each
  -- `x : supr U` an index `i : ι` such that `x` lies in `U i`
  choose index index_spec using λ x : supr U, opens.mem_supr.mp x.2,
  -- Using this data, we can glue our functions together to a single section
  let s : Π x : supr U, T x := λ x, sf (index x) ⟨x.1, index_spec x⟩,
  refine ⟨s,_,_⟩,
  { intro i,
    ext x,
    -- Now we need to verify that this lifted function restricts correctly to each set `U i`.
    -- Of course, the difficulty is that at any given point `x ∈ U i`,
    -- we may have used the axiom of choice to pick a different `j` with `x ∈ U j`
    -- when defining the function.
    -- Thus we'll need to use the fact that the restrictions are compatible.
    convert congr_fun (hsf (index ⟨x,_⟩) i) ⟨x,⟨index_spec ⟨x.1,_⟩,x.2⟩⟩,
    ext,
    refl },
  { -- Now we just need to check that the lift we picked was the only possible one.
    -- So we suppose we had some other gluing `t` of our sections
    intros t ht,
    -- and observe that we need to check that it agrees with our choice
    -- for each `f : s .X` and each `x ∈ supr U`.
    ext x,
    convert congr_fun (ht (index x)) ⟨x.1,index_spec x⟩,
    ext,
    refl }
end

-- We verify that the non-dependent version is an immediate consequence:
/--
The presheaf of not-necessarily-continuous functions to
a target type `T` satsifies the sheaf condition.
-/
lemma to_Type_is_sheaf (T : Type u) : (presheaf_to_Type X T).is_sheaf :=
to_Types_is_sheaf X (λ _, T)

end Top.presheaf

namespace Top

/--
The sheaf of not-necessarily-continuous functions on `X` with values in type family
`T : X → Type u`.
-/
def sheaf_to_Types (T : X → Type u) : sheaf (Type u) X :=
⟨presheaf_to_Types X T, presheaf.to_Types_is_sheaf _ _⟩

/--
The sheaf of not-necessarily-continuous functions on `X` with values in a type `T`.
-/
def sheaf_to_Type (T : Type u) : sheaf (Type u) X :=
⟨presheaf_to_Type X T, presheaf.to_Type_is_sheaf _ _⟩

end Top


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module order.rel_iso.set
! leanprover-community/mathlib commit ee0c179cd3c8a45aa5bffbf1b41d8dbede452865
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.RelIso.Basic
import Mathlib.Logic.Embedding.Set

/-!
# Interactions between relation homomorphisms and sets

It is likely that there are better homes for many of these statement,
in files further down the import graph.
-/

open Function

universe u v w

variable {α β γ δ : Type _} {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}
  {u : δ → δ → Prop}

namespace RelHomClass

variable {F : Type _}

theorem map_inf [SemilatticeInf α] [LinearOrder β]
    [RelHomClass F ((· < ·) : β → β → Prop) ((· < ·) : α → α → Prop)] (a : F) (m n : β) :
    a (m ⊓ n) = a m ⊓ a n :=
  (StrictMono.monotone fun _ _ => map_rel a).map_inf m n
#align rel_hom_class.map_inf RelHomClass.map_inf

theorem map_sup [SemilatticeSup α] [LinearOrder β]
    [RelHomClass F ((· > ·) : β → β → Prop) ((· > ·) : α → α → Prop)] (a : F) (m n : β) :
    a (m ⊔ n) = a m ⊔ a n :=
  @map_inf αᵒᵈ βᵒᵈ _ _ _ _ _ _ _
#align rel_hom_class.map_sup RelHomClass.map_sup

end RelHomClass

namespace RelIso

@[simp]
theorem range_eq (e : r ≃r s) : Set.range e = Set.univ :=
  Function.Surjective.range_eq e.surjective
#align rel_iso.range_eq RelIso.range_eq

end RelIso

/-- `subrel r p` is the inherited relation on a subset. -/
def Subrel (r : α → α → Prop) (p : Set α) : p → p → Prop :=
  (Subtype.val : p → α) ⁻¹'o r
#align subrel Subrel

@[simp]
theorem subrel_val (r : α → α → Prop) (p : Set α) {a b} : Subrel r p a b ↔ r a.1 b.1 :=
  Iff.rfl
#align subrel_val subrel_val

namespace Subrel

/-- The relation embedding from the inherited relation on a subset. -/
protected def relEmbedding (r : α → α → Prop) (p : Set α) : Subrel r p ↪r r :=
  ⟨Embedding.subtype _, Iff.rfl⟩
#align subrel.rel_embedding Subrel.relEmbedding

@[simp]
theorem relEmbedding_apply (r : α → α → Prop) (p a) : Subrel.relEmbedding r p a = a.1 :=
  rfl
#align subrel.rel_embedding_apply Subrel.relEmbedding_apply

instance (r : α → α → Prop) [IsWellOrder α r] (p : Set α) : IsWellOrder p (Subrel r p) :=
  RelEmbedding.isWellOrder (Subrel.relEmbedding r p)

instance (r : α → α → Prop) [IsRefl α r] (p : Set α) : IsRefl p (Subrel r p) :=
  ⟨fun x => @IsRefl.refl α r _ x⟩

instance (r : α → α → Prop) [IsSymm α r] (p : Set α) : IsSymm p (Subrel r p) :=
  ⟨fun x y => @IsSymm.symm α r _ x y⟩

instance (r : α → α → Prop) [IsTrans α r] (p : Set α) : IsTrans p (Subrel r p) :=
  ⟨fun x y z => @IsTrans.trans α r _ x y z⟩

instance (r : α → α → Prop) [IsIrrefl α r] (p : Set α) : IsIrrefl p (Subrel r p) :=
  ⟨fun x => @IsIrrefl.irrefl α r _ x⟩

end Subrel

/-- Restrict the codomain of a relation embedding. -/
def RelEmbedding.codRestrict (p : Set β) (f : r ↪r s) (H : ∀ a, f a ∈ p) : r ↪r Subrel s p :=
  ⟨f.toEmbedding.codRestrict p H, f.map_rel_iff'⟩
#align rel_embedding.cod_restrict RelEmbedding.codRestrict

@[simp]
theorem RelEmbedding.codRestrict_apply (p) (f : r ↪r s) (H a) :
    RelEmbedding.codRestrict p f H a = ⟨f a, H a⟩ :=
  rfl
#align rel_embedding.cod_restrict_apply RelEmbedding.codRestrict_apply