/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.vector
import data.list.nodup
import data.list.of_fn
import control.applicative
import meta.univs
/-!
# Additional theorems and definitions about the `vector` type

This file introduces the infix notation `::ᵥ` for `vector.cons`.
-/
universes u
variables {n : ℕ}

namespace vector
variables {α : Type*}

infixr ` ::ᵥ `:67  := vector.cons

attribute [simp] head_cons tail_cons

instance [inhabited α] : inhabited (vector α n) :=
⟨of_fn default⟩

theorem to_list_injective : function.injective (@to_list α n) :=
subtype.val_injective

/-- Two `v w : vector α n` are equal iff they are equal at every single index. -/
@[ext] theorem ext : ∀ {v w : vector α n}
  (h : ∀ m : fin n, vector.nth v m = vector.nth w m), v = w
| ⟨v, hv⟩ ⟨w, hw⟩ h := subtype.eq (list.ext_le (by rw [hv, hw])
  (λ m hm hn, h ⟨m, hv ▸ hm⟩))

/-- The empty `vector` is a `subsingleton`. -/
instance zero_subsingleton : subsingleton (vector α 0) :=
⟨λ _ _, vector.ext (λ m, fin.elim0 m)⟩

@[simp] theorem cons_val (a : α) : ∀ (v : vector α n), (a ::ᵥ v).val = a :: v.val
| ⟨_, _⟩ := rfl

@[simp] theorem cons_head (a : α) : ∀ (v : vector α n), (a ::ᵥ v).head = a
| ⟨_, _⟩ := rfl

@[simp] theorem cons_tail (a : α) : ∀ (v : vector α n), (a ::ᵥ v).tail = v
| ⟨_, _⟩ := rfl

@[simp] theorem to_list_of_fn : ∀ {n} (f : fin n → α), to_list (of_fn f) = list.of_fn f
| 0     f := rfl
| (n+1) f := by rw [of_fn, list.of_fn_succ, to_list_cons, to_list_of_fn]

@[simp] theorem mk_to_list :
  ∀ (v : vector α n) h, (⟨to_list v, h⟩ : vector α n) = v
| ⟨l, h₁⟩ h₂ := rfl

@[simp]
lemma length_coe (v : vector α n) :
  ((coe : { l : list α // l.length = n } → list α) v).length = n :=
v.2

@[simp] lemma to_list_map {β : Type*} (v : vector α n) (f : α → β) : (v.map f).to_list =
  v.to_list.map f := by cases v; refl

theorem nth_eq_nth_le : ∀ (v : vector α n) (i),
  nth v i = v.to_list.nth_le i.1 (by rw to_list_length; exact i.2)
| ⟨l, h⟩ i := rfl

@[simp]
lemma nth_repeat (a : α) (i : fin n) :
  (vector.repeat a n).nth i = a :=
by apply list.nth_le_repeat

@[simp] lemma nth_map {β : Type*} (v : vector α n) (f : α → β) (i : fin n) :
  (v.map f).nth i = f (v.nth i) :=
by simp [nth_eq_nth_le]

@[simp] theorem nth_of_fn {n} (f : fin n → α) (i) : nth (of_fn f) i = f i :=
by rw [nth_eq_nth_le, ← list.nth_le_of_fn f];
   congr; apply to_list_of_fn

@[simp] theorem of_fn_nth (v : vector α n) : of_fn (nth v) = v :=
begin
  rcases v with ⟨l, rfl⟩,
  apply to_list_injective,
  change nth ⟨l, eq.refl _⟩ with λ i, nth ⟨l, rfl⟩ i,
  simpa only [to_list_of_fn] using list.of_fn_nth_le _
end

/-- The natural equivalence between length-`n` vectors and functions from `fin n`. -/
def _root_.equiv.vector_equiv_fin (α : Type*) (n : ℕ) : vector α n ≃ (fin n → α) :=
⟨vector.nth, vector.of_fn, vector.of_fn_nth, λ f, funext $ vector.nth_of_fn f⟩

theorem nth_tail (x : vector α n) (i) :
  x.tail.nth i = x.nth ⟨i.1 + 1, lt_tsub_iff_right.mp i.2⟩ :=
by { rcases x with ⟨_|_, h⟩; refl, }

@[simp]
theorem nth_tail_succ : ∀ (v : vector α n.succ) (i : fin n),
  nth (tail v) i = nth v i.succ
| ⟨a::l, e⟩ ⟨i, h⟩ := by simp [nth_eq_nth_le]; refl

@[simp] theorem tail_val : ∀ (v : vector α n.succ), v.tail.val = v.val.tail
| ⟨a::l, e⟩ := rfl

/-- The `tail` of a `nil` vector is `nil`. -/
@[simp] lemma tail_nil : (@nil α).tail = nil := rfl

/-- The `tail` of a vector made up of one element is `nil`. -/
@[simp] lemma singleton_tail (v : vector α 1) : v.tail = vector.nil :=
by simp only [←cons_head_tail, eq_iff_true_of_subsingleton]

@[simp] theorem tail_of_fn {n : ℕ} (f : fin n.succ → α) :
  tail (of_fn f) = of_fn (λ i, f i.succ) :=
(of_fn_nth _).symm.trans $ by { congr, funext i, cases i, simp, }

/-- The list that makes up a `vector` made up of a single element,
retrieved via `to_list`, is equal to the list of that single element. -/
@[simp] lemma to_list_singleton (v : vector α 1) : v.to_list = [v.head] :=
begin
  rw ←v.cons_head_tail,
  simp only [to_list_cons, to_list_nil, cons_head, eq_self_iff_true,
             and_self, singleton_tail]
end

/-- Mapping under `id` does not change a vector. -/
@[simp] lemma map_id {n : ℕ} (v : vector α n) : vector.map id v = v :=
  vector.eq _ _ (by simp only [list.map_id, vector.to_list_map])

lemma mem_iff_nth {a : α} {v : vector α n} : a ∈ v.to_list ↔ ∃ i, v.nth i = a :=
by simp only [list.mem_iff_nth_le, fin.exists_iff, vector.nth_eq_nth_le];
  exact ⟨λ ⟨i, hi, h⟩, ⟨i, by rwa to_list_length at hi, h⟩,
    λ ⟨i, hi, h⟩, ⟨i, by rwa to_list_length, h⟩⟩

lemma nodup_iff_nth_inj {v : vector α n} : v.to_list.nodup ↔ function.injective v.nth :=
begin
  cases v with l hl,
  subst hl,
  simp only [list.nodup_iff_nth_le_inj],
  split,
  { intros h i j hij,
    cases i, cases j, ext, apply h, simpa },
  { intros h i j hi hj hij,
    have := @h ⟨i, hi⟩ ⟨j, hj⟩, simp [nth_eq_nth_le] at *, tauto }
end

@[simp] lemma nth_mem (i : fin n) (v : vector α n) : v.nth i ∈ v.to_list :=
by rw [nth_eq_nth_le]; exact list.nth_le_mem _ _ _

theorem head'_to_list : ∀ (v : vector α n.succ),
  (to_list v).head' = some (head v)
| ⟨a::l, e⟩ := rfl

/-- Reverse a vector. -/
def reverse (v : vector α n) : vector α n :=
⟨v.to_list.reverse, by simp⟩

/-- The `list` of a vector after a `reverse`, retrieved by `to_list` is equal
to the `list.reverse` after retrieving a vector's `to_list`. -/
lemma to_list_reverse {v : vector α n} : v.reverse.to_list = v.to_list.reverse := rfl

@[simp]
lemma reverse_reverse {v : vector α n} : v.reverse.reverse = v :=
by { cases v, simp [vector.reverse], }

@[simp] theorem nth_zero : ∀ (v : vector α n.succ), nth v 0 = head v
| ⟨a::l, e⟩ := rfl

@[simp] theorem head_of_fn
  {n : ℕ} (f : fin n.succ → α) : head (of_fn f) = f 0 :=
by rw [← nth_zero, nth_of_fn]

@[simp] theorem nth_cons_zero
  (a : α) (v : vector α n) : nth (a ::ᵥ v) 0 = a :=
by simp [nth_zero]

/-- Accessing the `nth` element of a vector made up
of one element `x : α` is `x` itself. -/
@[simp] lemma nth_cons_nil {ix : fin 1}
  (x : α) : nth (x ::ᵥ nil) ix = x :=
by convert nth_cons_zero x nil

@[simp] theorem nth_cons_succ
  (a : α) (v : vector α n) (i : fin n) : nth (a ::ᵥ v) i.succ = nth v i :=
by rw [← nth_tail_succ, tail_cons]

/-- The last element of a `vector`, given that the vector is at least one element. -/
def last (v : vector α (n + 1)) : α := v.nth (fin.last n)

/-- The last element of a `vector`, given that the vector is at least one element. -/
lemma last_def {v : vector α (n + 1)} : v.last = v.nth (fin.last n) := rfl

/-- The `last` element of a vector is the `head` of the `reverse` vector. -/
lemma reverse_nth_zero {v : vector α (n + 1)} : v.reverse.head = v.last :=
begin
  have : 0 = v.to_list.length - 1 - n,
  { simp only [nat.add_succ_sub_one, add_zero, to_list_length, tsub_self,
               list.length_reverse] },
  rw [←nth_zero, last_def, nth_eq_nth_le, nth_eq_nth_le],
  simp_rw [to_list_reverse, fin.val_eq_coe, fin.coe_last, fin.coe_zero, this],
  rw list.nth_le_reverse,
end

section scan

variables {β : Type*}
variables (f : β → α → β) (b : β)
variables (v : vector α n)

/--
Construct a `vector β (n + 1)` from a `vector α n` by scanning `f : β → α → β`
from the "left", that is, from 0 to `fin.last n`, using `b : β` as the starting value.
-/
def scanl : vector β (n + 1) :=
⟨list.scanl f b v.to_list, by rw [list.length_scanl, to_list_length]⟩

/-- Providing an empty vector to `scanl` gives the starting value `b : β`. -/
@[simp] lemma scanl_nil : scanl f b nil = b ::ᵥ nil := rfl

/--
The recursive step of `scanl` splits a vector `x ::ᵥ v : vector α (n + 1)`
into the provided starting value `b : β` and the recursed `scanl`
`f b x : β` as the starting value.

This lemma is the `cons` version of `scanl_nth`.
-/
@[simp] lemma scanl_cons (x : α) : scanl f b (x ::ᵥ v) = b ::ᵥ scanl f (f b x) v :=
by simpa only [scanl, to_list_cons]

/--
The underlying `list` of a `vector` after a `scanl` is the `list.scanl`
of the underlying `list` of the original `vector`.
-/
@[simp] lemma scanl_val : ∀ {v : vector α n}, (scanl f b v).val = list.scanl f b v.val
| ⟨l, hl⟩ := rfl

/--
The `to_list` of a `vector` after a `scanl` is the `list.scanl`
of the `to_list` of the original `vector`.
-/
@[simp] lemma to_list_scanl : (scanl f b v).to_list = list.scanl f b v.to_list := rfl

/--
The recursive step of `scanl` splits a vector made up of a single element
`x ::ᵥ nil : vector α 1` into a `vector` of the provided starting value `b : β`
and the mapped `f b x : β` as the last value.
-/
@[simp] lemma scanl_singleton (v : vector α 1) : scanl f b v = b ::ᵥ f b v.head ::ᵥ nil :=
begin
  rw [←cons_head_tail v],
  simp only [scanl_cons, scanl_nil, cons_head, singleton_tail]
end

/--
The first element of `scanl` of a vector `v : vector α n`,
retrieved via `head`, is the starting value `b : β`.
-/
@[simp] lemma scanl_head : (scanl f b v).head = b :=
begin
  cases n,
  { have : v = nil := by simp only [eq_iff_true_of_subsingleton],
    simp only [this, scanl_nil, cons_head] },
  { rw ←cons_head_tail v,
    simp only [←nth_zero, nth_eq_nth_le, to_list_scanl,
                to_list_cons, list.scanl, fin.val_zero', list.nth_le] }
end

/--
For an index `i : fin n`, the `nth` element of `scanl` of a
vector `v : vector α n` at `i.succ`, is equal to the application
function `f : β → α → β` of the `i.cast_succ` element of
`scanl f b v` and `nth v i`.

This lemma is the `nth` version of `scanl_cons`.
-/
@[simp] lemma scanl_nth (i : fin n) :
  (scanl f b v).nth i.succ = f ((scanl f b v).nth i.cast_succ) (v.nth i) :=
begin
  cases n,
  { exact fin_zero_elim i },
  induction n with n hn generalizing b,
  { have i0 : i = 0 := by simp only [eq_iff_true_of_subsingleton],
    simpa only [scanl_singleton, i0, nth_zero] },
  { rw [←cons_head_tail v, scanl_cons, nth_cons_succ],
    refine fin.cases _ _ i,
    { simp only [nth_zero, scanl_head, fin.cast_succ_zero, cons_head] },
    { intro i',
      simp only [hn, fin.cast_succ_fin_succ, nth_cons_succ] } }
end

end scan

/-- Monadic analog of `vector.of_fn`.
Given a monadic function on `fin n`, return a `vector α n` inside the monad. -/
def m_of_fn {m} [monad m] {α : Type u} : ∀ {n}, (fin n → m α) → m (vector α n)
| 0     f := pure nil
| (n+1) f := do a ← f 0, v ← m_of_fn (λi, f i.succ), pure (a ::ᵥ v)

theorem m_of_fn_pure {m} [monad m] [is_lawful_monad m] {α} :
  ∀ {n} (f : fin n → α), @m_of_fn m _ _ _ (λ i, pure (f i)) = pure (of_fn f)
| 0     f := rfl
| (n+1) f := by simp [m_of_fn, @m_of_fn_pure n, of_fn]

/-- Apply a monadic function to each component of a vector,
returning a vector inside the monad. -/
def mmap {m} [monad m] {α} {β : Type u} (f : α → m β) :
  ∀ {n}, vector α n → m (vector β n)
| 0 xs := pure nil
| (n+1) xs := do h' ← f xs.head, t' ← @mmap n xs.tail, pure (h' ::ᵥ t')

@[simp] theorem mmap_nil {m} [monad m] {α β} (f : α → m β) :
  mmap f nil = pure nil := rfl

@[simp] theorem mmap_cons {m} [monad m] {α β} (f : α → m β) (a) :
  ∀ {n} (v : vector α n), mmap f (a ::ᵥ v) =
  do h' ← f a, t' ← mmap f v, pure (h' ::ᵥ t')
| _ ⟨l, rfl⟩ := rfl

/-- Define `C v` by induction on `v : vector α n`.

This function has two arguments: `h_nil` handles the base case on `C nil`,
and `h_cons` defines the inductive step using `∀ x : α, C w → C (x ::ᵥ w)`. -/
@[elab_as_eliminator] def induction_on {C : Π {n : ℕ}, vector α n → Sort*}
  (v : vector α n)
  (h_nil : C nil)
  (h_cons : ∀ {n : ℕ} {x : α} {w : vector α n}, C w → C (x ::ᵥ w)) :
    C v :=
begin
  induction n with n ih generalizing v,
  { rcases v with ⟨_|⟨-,-⟩,-|-⟩,
    exact h_nil, },
  { rcases v with ⟨_|⟨a,v⟩,_⟩,
    cases v_property,
    apply @h_cons n _ ⟨v, (add_left_inj 1).mp v_property⟩,
    apply ih, }
end

variables {β γ : Type*}

/-- Define `C v w` by induction on a pair of vectors `v : vector α n` and `w : vector β n`. -/
@[elab_as_eliminator] def induction_on₂ {C : Π {n}, vector α n → vector β n → Sort*}
  (v : vector α n) (w : vector β n)
  (h_nil : C nil nil)
  (h_cons : ∀ {n a b} {x : vector α n} {y}, C x y → C (a ::ᵥ x) (b ::ᵥ y)) : C v w :=
begin
  induction n with n ih generalizing v w,
  { rcases v with ⟨_|⟨-,-⟩,-|-⟩, rcases w with ⟨_|⟨-,-⟩,-|-⟩,
    exact h_nil, },
  { rcases v with ⟨_|⟨a,v⟩,_⟩,
    cases v_property,
    rcases w with ⟨_|⟨b,w⟩,_⟩,
    cases w_property,
    apply @h_cons n _ _ ⟨v, (add_left_inj 1).mp v_property⟩ ⟨w, (add_left_inj 1).mp w_property⟩,
    apply ih, }
end

/-- Define `C u v w` by induction on a triplet of vectors
`u : vector α n`, `v : vector β n`, and `w : vector γ b`. -/
@[elab_as_eliminator] def induction_on₃ {C : Π {n}, vector α n → vector β n → vector γ n → Sort*}
  (u : vector α n) (v : vector β n) (w : vector γ n)
  (h_nil : C nil nil nil)
  (h_cons : ∀ {n a b c} {x : vector α n} {y z}, C x y z → C (a ::ᵥ x) (b ::ᵥ y) (c ::ᵥ z)) :
  C u v w :=
begin
  induction n with n ih generalizing u v w,
  { rcases u with ⟨_|⟨-,-⟩,-|-⟩, rcases v with ⟨_|⟨-,-⟩,-|-⟩, rcases w with ⟨_|⟨-,-⟩,-|-⟩,
    exact h_nil, },
  { rcases u with ⟨_|⟨a,u⟩,_⟩,
    cases u_property,
    rcases v with ⟨_|⟨b,v⟩,_⟩,
    cases v_property,
    rcases w with ⟨_|⟨c,w⟩,_⟩,
    cases w_property,
    apply @h_cons n _ _ _ ⟨u, (add_left_inj 1).mp u_property⟩ ⟨v, (add_left_inj 1).mp v_property⟩
      ⟨w, (add_left_inj 1).mp w_property⟩,
    apply ih, }
end

/-- Cast a vector to an array. -/
def to_array : vector α n → array n α
| ⟨xs, h⟩ := cast (by rw h) xs.to_array

section insert_nth
variable {a : α}

/-- `v.insert_nth a i` inserts `a` into the vector `v` at position `i`
(and shifting later components to the right). -/
def insert_nth (a : α) (i : fin (n+1)) (v : vector α n) : vector α (n+1) :=
⟨v.1.insert_nth i a,
  begin
    rw [list.length_insert_nth, v.2],
    rw [v.2, ← nat.succ_le_succ_iff],
    exact i.2
  end⟩

lemma insert_nth_val {i : fin (n+1)} {v : vector α n} :
  (v.insert_nth a i).val = v.val.insert_nth i.1 a :=
rfl

@[simp] lemma remove_nth_val {i : fin n} :
  ∀{v : vector α n}, (remove_nth i v).val = v.val.remove_nth i
| ⟨l, hl⟩ := rfl

lemma remove_nth_insert_nth {v : vector α n} {i : fin (n+1)} :
  remove_nth i (insert_nth a i v) = v :=
subtype.eq $ list.remove_nth_insert_nth i.1 v.1

lemma remove_nth_insert_nth' {v : vector α (n+1)} :
  ∀{i : fin (n+1)} {j : fin (n+2)},
    remove_nth (j.succ_above i) (insert_nth a j v) = insert_nth a (i.pred_above j) (remove_nth i v)
| ⟨i, hi⟩ ⟨j, hj⟩ :=
  begin
    dsimp [insert_nth, remove_nth, fin.succ_above, fin.pred_above],
    simp only [subtype.mk_eq_mk],
    split_ifs,
    { convert (list.insert_nth_remove_nth_of_ge i (j-1) _ _ _).symm,
      { convert (nat.succ_pred_eq_of_pos _).symm, exact lt_of_le_of_lt (zero_le _) h, },
      { apply remove_nth_val, },
      { convert hi, exact v.2, },
      { exact nat.le_pred_of_lt h, }, },
    { convert (list.insert_nth_remove_nth_of_le i j _ _ _).symm,
      { apply remove_nth_val, },
      { convert hi, exact v.2, },
      { simpa using h, }, }
  end

lemma insert_nth_comm (a b : α) (i j : fin (n+1)) (h : i ≤ j) :
  ∀(v : vector α n),
    (v.insert_nth a i).insert_nth b j.succ = (v.insert_nth b j).insert_nth a i.cast_succ
| ⟨l, hl⟩ :=
  begin
    refine subtype.eq _,
    simp only [insert_nth_val, fin.coe_succ, fin.cast_succ, fin.val_eq_coe, fin.coe_cast_add],
    apply list.insert_nth_comm,
    { assumption },
    { rw hl, exact nat.le_of_succ_le_succ j.2 }
  end

end insert_nth

section update_nth

/-- `update_nth v n a` replaces the `n`th element of `v` with `a` -/
def update_nth (v : vector α n) (i : fin n) (a : α) : vector α n :=
⟨v.1.update_nth i.1 a, by rw [list.update_nth_length, v.2]⟩

@[simp] lemma to_list_update_nth (v : vector α n) (i : fin n) (a : α) :
  (v.update_nth i a).to_list = v.to_list.update_nth i a :=
rfl

@[simp] lemma nth_update_nth_same (v : vector α n) (i : fin n) (a : α) :
  (v.update_nth i a).nth i = a :=
by cases v; cases i; simp [vector.update_nth, vector.nth_eq_nth_le]

lemma nth_update_nth_of_ne {v : vector α n} {i j : fin n} (h : i ≠ j) (a : α) :
  (v.update_nth i a).nth j = v.nth j :=
by cases v; cases i; cases j; simp [vector.update_nth, vector.nth_eq_nth_le,
  list.nth_le_update_nth_of_ne (fin.vne_of_ne h)]

lemma nth_update_nth_eq_if {v : vector α n} {i j : fin n} (a : α) :
  (v.update_nth i a).nth j = if i = j then a else v.nth j :=
by split_ifs; try {simp *}; try {rw nth_update_nth_of_ne}; assumption

@[to_additive]
lemma prod_update_nth [monoid α] (v : vector α n) (i : fin n) (a : α) :
  (v.update_nth i a).to_list.prod =
    (v.take i).to_list.prod * a * (v.drop (i + 1)).to_list.prod :=
begin
  refine (list.prod_update_nth v.to_list i a).trans _,
  have : ↑i < v.to_list.length := lt_of_lt_of_le i.2 (le_of_eq v.2.symm),
  simp * at *
end

@[to_additive]
lemma prod_update_nth' [comm_group α] (v : vector α n) (i : fin n) (a : α) :
  (v.update_nth i a).to_list.prod =
    v.to_list.prod * (v.nth i)⁻¹ * a :=
begin
  refine (list.prod_update_nth' v.to_list i a).trans _,
  have : ↑i < v.to_list.length := lt_of_lt_of_le i.2 (le_of_eq v.2.symm),
  simp [this, nth_eq_nth_le, mul_assoc],
end

end update_nth

end vector

namespace vector

section traverse

variables {F G : Type u → Type u}
variables [applicative F] [applicative G]

open applicative functor
open list (cons) nat

private def traverse_aux {α β : Type u} (f : α → F β) :
  Π (x : list α), F (vector β x.length)
| []      := pure vector.nil
| (x::xs) := vector.cons <$> f x <*> traverse_aux xs

/-- Apply an applicative function to each component of a vector. -/
protected def traverse {α β : Type u} (f : α → F β) : vector α n → F (vector β n)
| ⟨v, Hv⟩ := cast (by rw Hv) $ traverse_aux f v

section
variables {α β : Type u}

@[simp] protected lemma traverse_def
  (f : α → F β) (x : α) : ∀ (xs : vector α n),
  (x ::ᵥ xs).traverse f = cons <$> f x <*> xs.traverse f :=
by rintro ⟨xs, rfl⟩; refl

protected lemma id_traverse : ∀ (x : vector α n), x.traverse id.mk = x :=
begin
  rintro ⟨x, rfl⟩, dsimp [vector.traverse, cast],
  induction x with x xs IH, {refl},
  simp! [IH], refl
end

end

open function

variables [is_lawful_applicative F] [is_lawful_applicative G]
variables {α β γ : Type u}

-- We need to turn off the linter here as
-- the `is_lawful_traversable` instance below expects a particular signature.
@[nolint unused_arguments]
protected lemma comp_traverse (f : β → F γ) (g : α → G β) : ∀ (x : vector α n),
  vector.traverse (comp.mk ∘ functor.map f ∘ g) x =
  comp.mk (vector.traverse f <$> vector.traverse g x) :=
by rintro ⟨x, rfl⟩; dsimp [vector.traverse, cast];
   induction x with x xs; simp! [cast, *] with functor_norm;
   [refl, simp [(∘)]]

protected lemma traverse_eq_map_id {α β} (f : α → β) : ∀ (x : vector α n),
  x.traverse (id.mk ∘ f) = id.mk (map f x) :=
by rintro ⟨x, rfl⟩; simp!;
   induction x; simp! * with functor_norm; refl

variable (η : applicative_transformation F G)

protected lemma naturality {α β : Type*}
  (f : α → F β) : ∀ (x : vector α n),
  η (x.traverse f) = x.traverse (@η _ ∘ f) :=
by rintro ⟨x, rfl⟩; simp! [cast];
   induction x with x xs IH; simp! * with functor_norm

end traverse

instance : traversable.{u} (flip vector n) :=
{ traverse := @vector.traverse n,
  map := λ α β, @vector.map.{u u} α β n }

instance : is_lawful_traversable.{u} (flip vector n) :=
{ id_traverse := @vector.id_traverse n,
  comp_traverse := @vector.comp_traverse n,
  traverse_eq_map_id := @vector.traverse_eq_map_id n,
  naturality := @vector.naturality n,
  id_map := by intros; cases x; simp! [(<$>)],
  comp_map := by intros; cases x; simp! [(<$>)] }

meta instance reflect [reflected_univ.{u}] {α : Type u} [has_reflect α] [reflected _ α] {n : ℕ} :
  has_reflect (vector α n) :=
λ v, @vector.induction_on n α (λ n, reflected _) v
  ((by reflect_name : reflected _ @vector.nil.{u}).subst `(α))
  (λ n x xs ih, (by reflect_name : reflected _ @vector.cons.{u}).subst₄ `(α) `(n) `(x) ih)

end vector


import group_theory.quotient_group
import group_theory.subgroup.basic
import algebra.category.Group.abelian
import category_theory.epi_mono

-- TODO: This should be integrated in the category theory library with a construction of an
-- explicit pushout cocone, etc.

variables {A B C : Type*} [add_comm_group A] [add_comm_group B] [add_comm_group C]

def compare_in_prod (f : A →+ B) (g : A →+ C) : A →+ B × C :=
{ to_fun := λ a, (f a, - g a),
  map_zero' := by simp,
  map_add' := λ x y, by { ext, simp, simp [add_comm] } }

@[derive add_comm_group]
def add_monoid_hom.pushout (f : A →+ B) (g : A →+ C) : Type* :=
(B × C) ⧸ (compare_in_prod f g).range

abbreviation add_monoid_hom.pushout_π (f : A →+ B) (g : A →+ C) :
  B × C →+ f.pushout g := quotient_add_group.mk' _

def add_monoid_hom.pushout_inl (f : A →+ B) (g : A →+ C) :
  B →+ f.pushout g :=
{ to_fun := λ b, f.pushout_π g (b,0),
  map_zero' := by { simp, use 0, simpa } ,
  map_add' := λ x y, by { erw quotient_add_group.eq_iff_sub_mem, simp, use 0, simpa } }

def add_monoid_hom.pushout_inr (f : A →+ B) (g : A →+ C) :
  C →+ f.pushout g :=
{ to_fun := λ b, f.pushout_π g (0,b),
  map_zero' := by { simp, use 0, simpa } ,
  map_add' := λ x y, by { erw quotient_add_group.eq_iff_sub_mem, simp, use 0, simpa } }

lemma surjective_of_comp_inl_eq_comp_inr (f : A →+ B)
  (h : f.range.subtype.pushout_inl f.range.subtype =
    f.range.subtype.pushout_inr f.range.subtype) : function.surjective f :=
begin
  intros b,
  apply_fun (λ e, e b) at h,
  dsimp [add_monoid_hom.pushout_inl, add_monoid_hom.pushout_inr] at h,
  rw quotient_add_group.eq_iff_sub_mem at h,
  simp at h,
  obtain ⟨⟨a,⟨a,rfl⟩⟩,ht⟩ := h,
  dsimp [compare_in_prod] at ht,
  apply_fun (λ e, e.fst) at ht,
  use a,
  exact ht,
end

open category_theory

theorem AddCommGroup.surjective_of_epi {A B : AddCommGroup} (f : A ⟶ B) [epi f] :
  function.surjective f :=
begin
  apply surjective_of_comp_inl_eq_comp_inr,
  apply_fun AddCommGroup.of_hom,
  swap, { tidy },
  erw ← cancel_epi f,
  change add_monoid_hom.comp _ _ = add_monoid_hom.comp _ _,
  ext,
  dsimp [AddCommGroup.of_hom, add_monoid_hom.pushout_inl,
    add_monoid_hom.pushout_inr],
  rw quotient_add_group.eq_iff_sub_mem,
  simp,
  use ⟨_,⟨x,rfl⟩⟩,
  refl,
end

universes u

open category_theory category_theory.preadditive

namespace AddCommGroup

variables {X Y : AddCommGroup.{u}} (f : X ⟶ Y)

-- move this (also, it doesn't seem to be used any longer)
lemma _root_.add_monoid_hom.range_eq_top_iff {A B : Type*}
  [add_comm_group A] [add_comm_group B] (f : A →+ B) :
  f.range = ⊤ ↔ function.surjective f :=
begin
  rw [eq_top_iff],
  split,
  { rintro h x, exact h (add_subgroup.mem_top x), },
  { rintro h x -, exact h x },
end

-- instance mono_as_hom'_subtype (U : add_subgroup X) : mono ↑U.subtype :=
-- (mono_iff_ker_eq_bot _).mpr (submodule.ker_subtype U)

-- instance epi_as_hom''_mkq (U : submodule R X) : epi ↿U.mkq :=
-- (epi_iff_range_eq_top _).mpr $ submodule.range_mkq _

end AddCommGroup


/-
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.topology.sheaves.local_predicate
import Mathlib.topology.sheaves.stalks
import Mathlib.PostPort

universes v

namespace Mathlib

/-!
# Sheafification of `Type` valued presheaves

We construct the sheafification of a `Type` valued presheaf,
as the subsheaf of dependent functions into the stalks
consisting of functions which are locally germs.

We show that the stalks of the sheafification are isomorphic to the original stalks,
via `stalk_to_fiber` which evaluates a germ of a dependent function at a point.

We construct a morphism `to_sheafify` from a presheaf to (the underlying presheaf of)
its sheafification, given by sending a section to its collection of germs.

## Future work
Show that the map induced on stalks by `to_sheafify` is the inverse of `stalk_to_fiber`.

Show sheafification is a functor from presheaves to sheaves,
and that it is the left adjoint of the forgetful functor,
following https://stacks.math.columbia.edu/tag/007X.
-/

namespace Top.presheaf

namespace sheafify

/--
The prelocal predicate on functions into the stalks, asserting that the function is equal to a germ.
-/
def is_germ {X : Top} (F : presheaf (Type v) X) : prelocal_predicate fun (x : ↥X) => stalk F x :=
  prelocal_predicate.mk
    (fun (U : topological_space.opens ↥X) (f : (x : ↥U) → stalk F ↑x) =>
      ∃ (g : category_theory.functor.obj F (opposite.op U)), ∀ (x : ↥U), f x = germ F x g)
    sorry

/--
The local predicate on functions into the stalks,
asserting that the function is locally equal to a germ.
-/
def is_locally_germ {X : Top} (F : presheaf (Type v) X) :
    local_predicate fun (x : ↥X) => stalk F x :=
  prelocal_predicate.sheafify (is_germ F)

end sheafify

/--
The sheafification of a `Type` valued presheaf, defined as the functions into the stalks which
are locally equal to germs.
-/
def sheafify {X : Top} (F : presheaf (Type v) X) : sheaf (Type v) X := subsheaf_to_Types sorry

/--
The morphism from a presheaf to its sheafification,
sending each section to its germs.
(This forms the unit of the adjunction.)
-/
def to_sheafify {X : Top} (F : presheaf (Type v) X) : F ⟶ sheaf.presheaf (sheafify F) :=
  category_theory.nat_trans.mk
    fun (U : topological_space.opens ↥Xᵒᵖ) (f : category_theory.functor.obj F U) =>
      { val := fun (x : ↥(opposite.unop U)) => germ F x f, property := sorry }

/--
The natural morphism from the stalk of the sheafification to the original stalk.
In `sheafify_stalk_iso` we show this is an isomorphism.
-/
def stalk_to_fiber {X : Top} (F : presheaf (Type v) X) (x : ↥X) :
    stalk (sheaf.presheaf (sheafify F)) x ⟶ stalk F x :=
  stalk_to_fiber (sheafify.is_locally_germ F) x

theorem stalk_to_fiber_surjective {X : Top} (F : presheaf (Type v) X) (x : ↥X) :
    function.surjective (stalk_to_fiber F x) :=
  sorry

theorem stalk_to_fiber_injective {X : Top} (F : presheaf (Type v) X) (x : ↥X) :
    function.injective (stalk_to_fiber F x) :=
  sorry

/--
The isomorphism betweeen a stalk of the sheafification and the original stalk.
-/
def sheafify_stalk_iso {X : Top} (F : presheaf (Type v) X) (x : ↥X) :
    stalk (sheaf.presheaf (sheafify F)) x ≅ stalk F x :=
  equiv.to_iso (equiv.of_bijective (stalk_to_fiber F x) sorry)

end Mathlib


import homotopy.loop
import homotopy.tactic

/-!
# The Fundamental Group of a Topological Space

In this file, we define the fundamental group `π₁ x₀` of a topological space `X` based at `x₀`.
-/

noncomputable theory

variables {X : Type _} [topological_space X]

/--
For `x₀ : X`, `π₁ x₀` is the fundamental group of `X` based at `x₀`.
-/
@[nolint has_inhabited_instance] -- I think it might be always inhabited? But I'm not sure.
def π₁ (x₀ : X) := quotient (@loop.setoid _ _ x₀)

namespace π₁

variables {x₀ : X}

/--
Multiplication of elements in `π₁ x₀` is defined by joining the paths of an element of the
homotopy class.
-/
def mul (l₀ l₁ : π₁ x₀) : π₁ x₀ := quotient.lift₂ (λ l l' : loop x₀, quotient.mk (l.trans l'))
  begin
    rintros p₁ p₂ q₁ q₂ ⟨h₁⟩ ⟨h₂⟩,
    simp only [quotient.eq],
    exact ⟨path_homotopy.trans₂ h₁ h₂⟩,
  end l₀ l₁

/--
The identity in `π₁ x₀` is the homotopy class of the coonstant path.
-/
def one : π₁ x₀ := quotient.mk (path'.const x₀)

/--
The inverse of an element `l` of `π₁ x₀` is defined by taking the inverse of an element of the
equivalence class.
-/
def inv (l : π₁ x₀) : π₁ x₀ := quotient.lift (λ l', quotient.mk (path'.inv l'))
  begin
    rintros p₁ p₂ ⟨h₁⟩,
    simp only [quotient.eq],
    exact ⟨h₁.inv⟩,
  end l

instance : has_mul (π₁ x₀) := ⟨mul⟩
instance : has_one (π₁ x₀) := ⟨one⟩
instance : has_inv (π₁ x₀) := ⟨inv⟩

lemma mul_def (l₀ l₁ : loop x₀) : @has_mul.mul (π₁ x₀) _ (⟦l₀⟧ : π₁ x₀) ⟦l₁⟧ = ⟦l₀.trans l₁⟧ := rfl
lemma one_def : (1 : π₁ x₀) = ⟦path'.const x₀⟧ := rfl
lemma inv_def (l : loop x₀) : @has_inv.inv (π₁ x₀) _ ⟦l⟧ = ⟦path'.inv l⟧ := rfl

lemma mul_assoc (l₀ l₁ l₂ : π₁ x₀) : l₀ * l₁ * l₂ = l₀ * (l₁ * l₂) :=
quotient.induction_on₃ l₀ l₁ l₂ (λ p₀ p₁ p₂, begin
    simp only [mul_def, quotient.eq],
    exact ⟨path_homotopy.assoc⟩,
  end)

lemma one_mul (l : π₁ x₀) : 1 * l = l :=
quotient.induction_on l (λ p, begin
    simp only [one_def, mul_def, quotient.eq],
    exact ⟨(path_homotopy.const_trans p).symm⟩,
  end)

lemma mul_one (l : π₁ x₀) : l * 1 = l :=
quotient.induction_on l (λ p, begin
    simp only [one_def, mul_def, quotient.eq],
    exact ⟨(path_homotopy.trans_const p).symm⟩,
  end)

lemma mul_left_inv (l : π₁ x₀) : l⁻¹ * l = 1 :=
quotient.induction_on l (λ p, begin
    simp [one_def, mul_def, inv_def],
    refine ⟨path_homotopy.trans_left_inv⟩,
  end)

/--
The `group` instance for `π₁ x₀`.
-/
instance : group (π₁ x₀) :=
{ mul_assoc := mul_assoc,
  one_mul := one_mul,
  mul_one := mul_one,
  mul_left_inv := mul_left_inv,
  ..π₁.has_mul, ..π₁.has_inv, ..π₁.has_one }

section defs

open path_homotopy.tactic

/--
Given a path `α` from `x₀` to `x₁`, we can define a group isomorphism from `π₁ x₀` to `π₁ x₁`.
-/
def change_of_basepoint {x₀ x₁ : X} (α : path' x₀ x₁) : π₁ x₀ ≃* π₁ x₁ :=
{ to_fun := quotient.lift (λ l, ⟦(α.inv.trans l).trans α⟧) begin
    rintros a b ⟨h⟩,
    rw quotient.eq,
    exact ⟨path_homotopy.trans₂
      (path_homotopy.trans₂ (path_homotopy.refl _) h) (path_homotopy.refl _)⟩,
  end,
  inv_fun := quotient.lift (λ l, ⟦(α.trans l).trans α.inv⟧) begin
    rintros a b ⟨h⟩,
    rw quotient.eq,
    refine
      ⟨path_homotopy.trans₂ (path_homotopy.trans₂ (path_homotopy.refl _) h) (path_homotopy.refl _)⟩,
  end,
  left_inv := begin
    intro l,
    apply quotient.induction_on l,
    intro p,
    rw [quotient.lift_mk, quotient.lift_mk, quotient.eq],
    refine ⟨homotopy_with.trans
      (homotopy_with.trans _ (path_homotopy.trans₂ (@path_homotopy.trans_right_inv _ _ _ _ α)
        (path_homotopy.trans₂ (path_homotopy.refl _) (@path_homotopy.trans_right_inv _ _ _ _ α))))
        (homotopy_with.trans (path_homotopy.trans_const _) (path_homotopy.const_trans _)).symm⟩,
    assocl, assocr',
    refine path_homotopy.trans₂ (path_homotopy.refl _) _,
    assocl, assocl,
    exact path_homotopy.refl _,
  end,
  right_inv := begin
    intro l,
    apply quotient.induction_on l,
    intro p,
    rw [quotient.lift_mk, quotient.lift_mk, quotient.eq],
    refine ⟨homotopy_with.trans
      (homotopy_with.trans _ (path_homotopy.trans₂ (@path_homotopy.trans_left_inv _ _ _ _ α)
        (path_homotopy.trans₂ (path_homotopy.refl _) (@path_homotopy.trans_left_inv _ _ _ _ α))))
        (homotopy_with.trans (path_homotopy.trans_const _) (path_homotopy.const_trans _)).symm⟩,
    assocl, assocr',
    refine path_homotopy.trans₂ (path_homotopy.refl _) _,
    assocl, assocl,
    refine path_homotopy.trans₂ (path_homotopy.refl _) _,
    exact path_homotopy.refl _,
  end,
  map_mul' := begin
    intros x y,
    apply quotient.induction_on₂ x y,
    intros p q,
    rw [mul_def, quotient.lift_mk, quotient.lift_mk, quotient.lift_mk, mul_def, quotient.eq],
    exact ⟨homotopy_with.trans (path_homotopy.trans₂ (homotopy_with.trans
      (homotopy_with.trans path_homotopy.assoc.symm (path_homotopy.trans₂ (homotopy_with.trans
        (homotopy_with.trans (path_homotopy.trans_const _)
      (path_homotopy.trans₂
        (path_homotopy.refl _) path_homotopy.trans_right_inv.symm)) path_homotopy.assoc.symm)
        (path_homotopy.refl _)))
        path_homotopy.assoc)
      (path_homotopy.refl _)) path_homotopy.assoc⟩,
  end }

/--
Given a continuous function `f : C(X, Y)`, we have a group homomorphism from `π₁ x₀` to `π₁ (f x₀)`.
-/
def map {Y : Type _} [topological_space Y] (f : C(X, Y)) : π₁ x₀ →* π₁ (f x₀) :=
{ to_fun := quotient.lift (λ l, ⟦path'.map l f⟧) begin
    rintros a b ⟨h⟩,
    rw [quotient.eq],
    exact ⟨h.map _⟩,
  end,
  map_one' := begin
    rw [one_def, one_def, quotient.lift_mk, quotient.eq],
    exact ⟨path_homotopy.of_refl (path'.const_map _ _)⟩,
  end,
  map_mul' := begin
    intros x y,
    apply quotient.induction_on₂ x y,
    intros p q,
    rw [mul_def, quotient.lift_mk, quotient.lift_mk, quotient.lift_mk, mul_def, quotient.eq],
    refine ⟨path_homotopy.of_refl (path'.map_trans _ _ _)⟩,
  end } .

lemma map_comp {Y Z : Type _} [topological_space Y] [topological_space Z] (h : C(X, Y)) (k : C(Y, Z)) :
  @map _ _ x₀ _ _ (k.comp h) = (map k).comp (map h) :=
begin
  ext t,
  apply quotient.induction_on t,
  intro a,
  simp [map],
end

@[simp] lemma map_id :
  @map _ _ x₀ _ _ continuous_map.id = monoid_hom.id _ :=
begin
  ext t,
  apply quotient.induction_on t,
  intro a,
  simp only [map, path'.map, quotient.lift_mk, monoid_hom.id_apply, monoid_hom.coe_mk, quotient.eq],
  refine ⟨path_homotopy.of_refl _⟩,
  ext u,
  refl,
end

end defs

section path_connected

variable [path_connected_space X]

/--
In a path connected space `X`, for `x₀ x₁ : X`, `π₁ x₀` and `π₁ x₁` are isomorphic.
-/
noncomputable def mul_equiv_of_path_connected (x₀ x₁ : X) :
  π₁ x₀ ≃* π₁ x₁ :=
change_of_basepoint (path'.of_path (path_connected_space.some_path x₀ x₁))

end path_connected

end π₁


import number_theory.bernoulli

--OUTPUT 1
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  -- We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
  apply nat.strong_induction_on n,
  assume n hn,
  -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
  have h1 : (n + 1) * (polynomial.bernoulli n).eval (1 + x) = (n + 1) * (polynomial.bernoulli n).eval x + (n + 1) * n * x^(n - 1), from by auto [hn],
  -- We will use the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number)
  have h2 : ∀ (l : ℕ), (polynomial.sum (λ (k : ℕ), (polynomial.binomial (l + 1) k) * (polynomial.bernoulli k)) l).eval x = (l + 1) * x^l, from by auto [polynomial.sum_eval],
  -- The conclusion then follows easily.
  have h3 : (n + 1) * (polynomial.bernoulli n).eval (1 + x) = (polynomial.sum (λ (k : ℕ), (polynomial.binomial (n + 1) k) * (polynomial.bernoulli k)) n).eval x, from by auto [polynomial.eval_sum, polynomial.eval_binomial],
  have h4 : (n + 1) * (polynomial.bernoulli n).eval x = (polynomial.sum (λ (k : ℕ), (polynomial.binomial (n + 1) k) * (polynomial.bernoulli k)) n).eval x - (n + 1) * n * x^(n - 1), from by auto [h1],
  show (polynomial.bernoulli (n + 1)).eval (1 + x) = (polynomial.bernoulli (n + 1)).eval x + (n + 1) * x^n, from by auto [h3, h4, h2],
end

--OUTPUT 2
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  -- We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
  apply nat.strong_induction_on n,
  assume d hd,
  -- Multiplying both sides by $d + 1$,
  have h1 : (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x^(d - 1), from by auto,
  have h2 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^(d - 1) * (d + 1), from by auto,
  have h3 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  -- and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
  have h4 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h5 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h6 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h7 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h8 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h9 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h10 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h11 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h12 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h13 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h14 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h15 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h16 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h17 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h18 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h19 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h20 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h21 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h22 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h23 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h24 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h25 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h26 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h27 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h28 : (polynomial.bernoulli d).eval (1 + x) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x^d, from by auto [pow_succ],
  have h29 : (polynomial.bernoulli d).eval (1 + x) * (d
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  -- We apply strong induction on $n$.
  apply nat.strong_induction_on n,
  -- So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$
  assume n hn,
  -- and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
  assume h1 : ∀ m < n, (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1),
  -- Multiplying both sides by $d + 1$,
  have h2 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = ((polynomial.bernoulli n).eval x + n * x^(n - 1)) * (n + 1), from by auto [h1],
  -- and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number),
  have h3 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [polynomial.eval_pow, polynomial.eval_add],
  -- we get that
  have h4 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h3],
  have h5 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h4],
  -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
  have h6 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h5],
  have h7 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h6],
  have h8 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h7],
  have h9 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h8],
  have h10 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h9],
  have h11 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h10],
  have h12 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h11],
  have h13 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h12],
  have h14 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h13],
  have h15 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h14],
  have h16 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h15],
  have h17 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h16],
  have h18 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h17],
  have h19 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h18],
  have h20 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h19],
  have h21 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h20],
  have h22 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h21],
  have h23 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h22],
  have h24 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h23],
  have h25 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h24],
  have h26 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h25],
  have h27 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h26],
  have h28 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from by auto [h27],
  have h29 : (polynomial.bernoulli n).eval (1 + x) * (n + 1) = (n + 1) * (1 + x)^n - (n + 1) * x^n, from
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  -- We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
  induction n with d hd,
  -- Base case: $n = 0$
  {
    -- $B_0 (1 + x) = B_0 (x) + 0 x^{0 - 1}$
    have h1 : (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(-1), from by auto [polynomial.bernoulli_zero],
    -- $B_0 (1 + x) = B_0 (x) + 0 x^{0 - 1} = B_0 (x)$
    have h2 : (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(-1) = (polynomial.bernoulli 0).eval x, from by auto [zero_mul],
    -- $B_0 (1 + x) = B_0 (x)$
    show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(-1), from by auto [h2],
  },
  -- Inductive step: $n = d$
  {
    -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
    -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
    have h1 : (d + 1) * ((1 + x)^d - x^d) = (d + 1) * ((polynomial.sum_range (λ k, (d + 1) * (polynomial.choose (d + 1) k) * (polynomial.bernoulli k).eval x * x^(d - k))) 0 d), from by auto [polynomial.eval_add, polynomial.eval_mul, polynomial.eval_pow, polynomial.eval_sub, polynomial.eval_sum_range, polynomial.eval_choose, polynomial.eval_const, polynomial.eval_X, polynomial.bernoulli_one, polynomial.bernoulli_two, polynomial.bernoulli_three, polynomial.bernoulli_four, polynomial.bernoulli_five, polynomial.bernoulli_six, polynomial.bernoulli_seven, polynomial.bernoulli_eight, polynomial.bernoulli_nine, polynomial.bernoulli_ten, polynomial.bernoulli_eleven, polynomial.bernoulli_twelve, polynomial.bernoulli_thirteen, polynomial.bernoulli_fourteen, polynomial.bernoulli_fifteen, polynomial.bernoulli_sixteen, polynomial.bernoulli_seventeen, polynomial.bernoulli_eighteen, polynomial.bernoulli_nineteen, polynomial.bernoulli_twenty],
    -- The conclusion then follows easily.
    have h2 : (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x^(d - 1), from by auto [hd, h1],
    show (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x^(d - 1), from by auto [h2],
  },
end

--OUTPUT 5
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  -- We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
  have h1 : ∀ (m : ℕ) (h : m < n), (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto [polynomial.bernoulli_eval_one_add],
  have h2 : ∀ (m : ℕ) (h : m < n), (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto [h1],

  -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
  -- $$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
  have h3 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [polynomial.bernoulli_eval_one_add, polynomial.bernoulli_eval_one_add],
  have h4 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h3],

  -- The conclusion then follows easily.
  have h5 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h4],
  have h6 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h5],

  have h7 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h6],
  have h8 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h7],

  have h9 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h8],
  have h10 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h9],

  have h11 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h10],
  have h12 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h11],

  have h13 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h12],
  have h14 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h13],

  have h15 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h14],
  have h16 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h15],

  have h17 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h16],
  have h18 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h17],

  have h19 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h18],
  have h20 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h19],

  have h21 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h20],
  have h22 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h21],

  have h23 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1)) (range n)), from by auto [h22],
  have h24 : (n + 1) * (1 + x)^n - (n + 1) * x^n = (sum (λ (l : ℕ), (n + 1) * (n choose l) * l * x^(l - 1
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  -- We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that
  -- $B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$
  assume h1 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1),

  -- Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$
  -- (where $B_k$ is the $k$-th Bernoulli number), we get that
  -- $(d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1}$
  have h2 : (n + 1) * (1 + x)^n - (n + 1) * x^n = ∑ l in finset.range (n + 1), (n + 1) * (finset.range n).card * x^l, from by auto [finset.sum_range_succ, finset.sum_range_succ, finset.sum_eq_single, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_range_succ, finset.sum_
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Bernoulli polynomial evaluation
Given a natural number $n$ and a rational $x$, let $B_n (x)$ denote the $n$-th Bernoulli polynomial evaluated at $x$. Then, $$B_n (1 + x) = B_n (x) + n x^{n - 1}$$
`proof`
We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
$$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
The conclusion then follows easily.

QED

-/
theorem  bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
FEW SHOT PROMPTS TO CODEX(END)-/


def compose (A B C : Type) (g : B -> C) (f : A -> B) :=
    fun x : A, g (f x)

lemma associative_compose
    (A B C D : Type)
    (f : A -> B)
    (g : B -> C)
    (h : C -> D) :
    compose A C D h (compose A B C g f) =
    compose A B D (compose B C D h g) f :=
    begin
        rw [compose, compose, compose, compose],
    end


import data.real.basic
import data.real.nnreal

theorem exo (f: nnreal -> nnreal) :
  (forall x y, f(x + f y) = f(x+y) + f y)
  -> forall x, f x = 2 * x
:=
  sorry


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

! This file was ported from Lean 3 source module category_theory.sites.spaces
! leanprover-community/mathlib commit b6fa3beb29f035598cf0434d919694c5e98091eb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Sites.Grothendieck
import Mathbin.CategoryTheory.Sites.Pretopology
import Mathbin.CategoryTheory.Limits.Lattice
import Mathbin.Topology.Sets.Opens

/-!
# Grothendieck topology on a topological space

Define the Grothendieck topology and the pretopology associated to a topological space, and show
that the pretopology induces the topology.

The covering (pre)sieves on `X` are those for which the union of domains contains `X`.

## Tags

site, Grothendieck topology, space

## References

* [nLab, *Grothendieck topology*](https://ncatlab.org/nlab/show/Grothendieck+topology)
* [S. MacLane, I. Moerdijk, *Sheaves in Geometry and Logic*][MM92]

## Implementation notes

We define the two separately, rather than defining the Grothendieck topology as that generated
by the pretopology for the purpose of having nice definitional properties for the sieves.
-/

universe u

namespace Opens

variable (T : Type u) [TopologicalSpace T]

open CategoryTheory TopologicalSpace CategoryTheory.Limits

/- warning: opens.grothendieck_topology -> Opens.grothendieckTopology is a dubious translation:
lean 3 declaration is
  forall (T : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} T], CategoryTheory.GrothendieckTopology.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (SetLike.partialOrder.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) T (TopologicalSpace.Opens.setLike.{u1} T _inst_1))))
but is expected to have type
  forall (T : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} T], CategoryTheory.GrothendieckTopology.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1)))))
Case conversion may be inaccurate. Consider using '#align opens.grothendieck_topology Opens.grothendieckTopologyₓ'. -/
/-- The Grothendieck topology associated to a topological space. -/
def grothendieckTopology : GrothendieckTopology (Opens T)
    where
  sieves X S := ∀ x ∈ X, ∃ (U : _)(f : U ⟶ X), S f ∧ x ∈ U
  top_mem' X x hx := ⟨_, 𝟙 _, trivial, hx⟩
  pullback_stable' X Y S f hf y hy :=
    by
    rcases hf y (f.le hy) with ⟨U, g, hg, hU⟩
    refine' ⟨U ⊓ Y, hom_of_le inf_le_right, _, hU, hy⟩
    apply S.downward_closed hg (hom_of_le inf_le_left)
  transitive' X S hS R hR x hx :=
    by
    rcases hS x hx with ⟨U, f, hf, hU⟩
    rcases hR hf _ hU with ⟨V, g, hg, hV⟩
    exact ⟨_, g ≫ f, hg, hV⟩
#align opens.grothendieck_topology Opens.grothendieckTopology

/- warning: opens.pretopology -> Opens.pretopology is a dubious translation:
lean 3 declaration is
  forall (T : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} T], CategoryTheory.Pretopology.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (SetLike.partialOrder.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) T (TopologicalSpace.Opens.setLike.{u1} T _inst_1)))) (Opens.pretopology._proof_1.{u1} T _inst_1)
but is expected to have type
  forall (T : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} T], CategoryTheory.Pretopology.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (CategoryTheory.Limits.hasPullbacks_of_hasWidePullbacks.{u1, u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (fun (J : Type.{u1}) => CategoryTheory.Limits.hasLimitsOfShapeOfHasLimits.{u1, u1, u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (CategoryTheory.Limits.WidePullbackShape.{u1} J) (CategoryTheory.Limits.WidePullbackShape.category.{u1} J) (CategoryTheory.Limits.CompleteLattice.hasLimits_of_completeLattice.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))
Case conversion may be inaccurate. Consider using '#align opens.pretopology Opens.pretopologyₓ'. -/
/-- The Grothendieck pretopology associated to a topological space. -/
def pretopology : Pretopology (Opens T)
    where
  coverings X R := ∀ x ∈ X, ∃ (U : _)(f : U ⟶ X), R f ∧ x ∈ U
  has_isos X Y f i x hx := ⟨_, _, presieve.singleton_self _, (inv f).le hx⟩
  pullbacks X Y f S hS x hx :=
    by
    rcases hS _ (f.le hx) with ⟨U, g, hg, hU⟩
    refine' ⟨_, _, presieve.pullback_arrows.mk _ _ hg, _⟩
    have : U ⊓ Y ≤ pullback g f
    refine' le_of_hom (pullback.lift (hom_of_le inf_le_left) (hom_of_le inf_le_right) rfl)
    apply this ⟨hU, hx⟩
  Transitive X S Ti hS hTi x hx :=
    by
    rcases hS x hx with ⟨U, f, hf, hU⟩
    rcases hTi f hf x hU with ⟨V, g, hg, hV⟩
    exact ⟨_, _, ⟨_, g, f, hf, hg, rfl⟩, hV⟩
#align opens.pretopology Opens.pretopology

/- warning: opens.pretopology_of_grothendieck -> Opens.pretopology_ofGrothendieck is a dubious translation:
lean 3 declaration is
  forall (T : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} T], Eq.{succ u1} (CategoryTheory.Pretopology.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (SetLike.partialOrder.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) T (TopologicalSpace.Opens.setLike.{u1} T _inst_1)))) (Opens.pretopology._proof_1.{u1} T _inst_1)) (CategoryTheory.Pretopology.ofGrothendieck.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (SetLike.partialOrder.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) T (TopologicalSpace.Opens.setLike.{u1} T _inst_1)))) (Opens.pretopology._proof_1.{u1} T _inst_1) (Opens.grothendieckTopology.{u1} T _inst_1)) (Opens.pretopology.{u1} T _inst_1)
but is expected to have type
  forall (T : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} T], Eq.{succ u1} (CategoryTheory.Pretopology.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (CategoryTheory.Limits.hasPullbacks_of_hasWidePullbacks.{u1, u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (fun (J : Type.{u1}) => CategoryTheory.Limits.hasLimitsOfShapeOfHasLimits.{u1, u1, u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (CategoryTheory.Limits.WidePullbackShape.{u1} J) (CategoryTheory.Limits.WidePullbackShape.category.{u1} J) (CategoryTheory.Limits.CompleteLattice.hasLimits_of_completeLattice.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (CategoryTheory.Pretopology.ofGrothendieck.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (CategoryTheory.Limits.hasPullbacks_of_hasWidePullbacks.{u1, u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (fun (J : Type.{u1}) => CategoryTheory.Limits.hasLimitsOfShapeOfHasLimits.{u1, u1, u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (CategoryTheory.Limits.WidePullbackShape.{u1} J) (CategoryTheory.Limits.WidePullbackShape.category.{u1} J) (CategoryTheory.Limits.CompleteLattice.hasLimits_of_completeLattice.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1)))) (Opens.grothendieckTopology.{u1} T _inst_1)) (Opens.pretopology.{u1} T _inst_1)
Case conversion may be inaccurate. Consider using '#align opens.pretopology_of_grothendieck Opens.pretopology_ofGrothendieckₓ'. -/
/-- The pretopology associated to a space is the largest pretopology that
    generates the Grothendieck topology associated to the space. -/
@[simp]
theorem pretopology_ofGrothendieck :
    Pretopology.ofGrothendieck _ (Opens.grothendieckTopology T) = Opens.pretopology T :=
  by
  apply le_antisymm
  · intro X R hR x hx
    rcases hR x hx with ⟨U, f, ⟨V, g₁, g₂, hg₂, _⟩, hU⟩
    exact ⟨V, g₂, hg₂, g₁.le hU⟩
  · intro X R hR x hx
    rcases hR x hx with ⟨U, f, hf, hU⟩
    exact ⟨U, f, sieve.le_generate R U hf, hU⟩
#align opens.pretopology_of_grothendieck Opens.pretopology_ofGrothendieck

/- warning: opens.pretopology_to_grothendieck -> Opens.pretopology_toGrothendieck is a dubious translation:
lean 3 declaration is
  forall (T : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} T], Eq.{succ u1} (CategoryTheory.GrothendieckTopology.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (SetLike.partialOrder.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) T (TopologicalSpace.Opens.setLike.{u1} T _inst_1))))) (CategoryTheory.Pretopology.toGrothendieck.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (SetLike.partialOrder.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) T (TopologicalSpace.Opens.setLike.{u1} T _inst_1)))) (Opens.pretopology._proof_1.{u1} T _inst_1) (Opens.pretopology.{u1} T _inst_1)) (Opens.grothendieckTopology.{u1} T _inst_1)
but is expected to have type
  forall (T : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} T], Eq.{succ u1} (CategoryTheory.GrothendieckTopology.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1)))))) (CategoryTheory.Pretopology.toGrothendieck.{u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (CategoryTheory.Limits.hasPullbacks_of_hasWidePullbacks.{u1, u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (fun (J : Type.{u1}) => CategoryTheory.Limits.hasLimitsOfShapeOfHasLimits.{u1, u1, u1, u1} (TopologicalSpace.Opens.{u1} T _inst_1) (Preorder.smallCategory.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1))))) (CategoryTheory.Limits.WidePullbackShape.{u1} J) (CategoryTheory.Limits.WidePullbackShape.category.{u1} J) (CategoryTheory.Limits.CompleteLattice.hasLimits_of_completeLattice.{u1} (TopologicalSpace.Opens.{u1} T _inst_1) (TopologicalSpace.Opens.instCompleteLatticeOpens.{u1} T _inst_1)))) (Opens.pretopology.{u1} T _inst_1)) (Opens.grothendieckTopology.{u1} T _inst_1)
Case conversion may be inaccurate. Consider using '#align opens.pretopology_to_grothendieck Opens.pretopology_toGrothendieckₓ'. -/
/-- The pretopology associated to a space induces the Grothendieck topology associated to the space.
-/
@[simp]
theorem pretopology_toGrothendieck :
    Pretopology.toGrothendieck _ (Opens.pretopology T) = Opens.grothendieckTopology T :=
  by
  rw [← pretopology_of_grothendieck]
  apply (pretopology.gi (opens T)).l_u_eq
#align opens.pretopology_to_grothendieck Opens.pretopology_toGrothendieck

end Opens


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import topology.homeomorph
/-!
# Compact sets

## Summary

We define the subtype of compact sets in a topological space.

## Main Definitions

- `closeds α` is the type of closed subsets of a topological space `α`.
- `compacts α` is the type of compact subsets of a topological space `α`.
- `nonempty_compacts α` is the type of non-empty compact subsets.
- `positive_compacts α` is the type of compact subsets with non-empty interior.
-/
open set

variables (α : Type*) {β : Type*} [topological_space α] [topological_space β]
namespace topological_space

/-- The type of closed subsets of a topological space. -/
def closeds := {s : set α // is_closed s}

/-- The type of closed subsets is inhabited, with default element the empty set. -/
instance : inhabited (closeds α) := ⟨⟨∅, is_closed_empty ⟩⟩

/-- The compact sets of a topological space. See also `nonempty_compacts`. -/
def compacts : Type* := { s : set α // is_compact s }

/-- The type of non-empty compact subsets of a topological space. The
non-emptiness will be useful in metric spaces, as we will be able to put
a distance (and not merely an edistance) on this space. -/
def nonempty_compacts := {s : set α // s.nonempty ∧ is_compact s}

/-- In an inhabited space, the type of nonempty compact subsets is also inhabited, with
default element the singleton set containing the default element. -/
instance nonempty_compacts_inhabited [inhabited α] : inhabited (nonempty_compacts α) :=
⟨⟨{default}, singleton_nonempty default, is_compact_singleton ⟩⟩

/-- The compact sets with nonempty interior of a topological space. See also `compacts` and
  `nonempty_compacts`. -/
@[nolint has_inhabited_instance]
def positive_compacts: Type* := { s : set α // is_compact s ∧ (interior s).nonempty }

/-- In a nonempty compact space, `set.univ` is a member of `positive_compacts`, the compact sets
with nonempty interior. -/
def positive_compacts_univ {α : Type*} [topological_space α] [compact_space α] [nonempty α] :
  positive_compacts α :=
⟨set.univ, compact_univ, by simp⟩

@[simp] lemma positive_compacts_univ_val (α : Type*) [topological_space α] [compact_space α]
  [nonempty α] : (positive_compacts_univ : positive_compacts α).val = univ := rfl

variables {α}

namespace compacts

instance : semilattice_sup (compacts α) :=
subtype.semilattice_sup (λ K₁ K₂, is_compact.union)

instance : order_bot (compacts α) :=
subtype.order_bot is_compact_empty

instance [t2_space α]: semilattice_inf (compacts α) :=
subtype.semilattice_inf (λ K₁ K₂, is_compact.inter)

instance [t2_space α] : lattice (compacts α) :=
subtype.lattice (λ K₁ K₂, is_compact.union) (λ K₁ K₂, is_compact.inter)

@[simp] lemma bot_val : (⊥ : compacts α).1 = ∅ := rfl

@[simp] lemma sup_val {K₁ K₂ : compacts α} : (K₁ ⊔ K₂).1 = K₁.1 ∪ K₂.1 := rfl

@[ext] protected lemma ext {K₁ K₂ : compacts α} (h : K₁.1 = K₂.1) : K₁ = K₂ :=
subtype.eq h

@[simp] lemma finset_sup_val {β} {K : β → compacts α} {s : finset β} :
  (s.sup K).1 = s.sup (λ x, (K x).1) :=
finset.sup_coe _ _

instance : inhabited (compacts α) := ⟨⊥⟩

/-- The image of a compact set under a continuous function. -/
protected def map (f : α → β) (hf : continuous f) (K : compacts α) : compacts β :=
⟨f '' K.1, K.2.image hf⟩

@[simp] lemma map_val {f : α → β} (hf : continuous f) (K : compacts α) :
  (K.map f hf).1 = f '' K.1 := rfl

/-- A homeomorphism induces an equivalence on compact sets, by taking the image. -/
@[simp] protected def equiv (f : α ≃ₜ β) : compacts α ≃ compacts β :=
{ to_fun := compacts.map f f.continuous,
  inv_fun := compacts.map _ f.symm.continuous,
  left_inv := by { intro K, ext1, simp only [map_val, ← image_comp, f.symm_comp_self, image_id] },
  right_inv := by { intro K, ext1,
    simp only [map_val, ← image_comp, f.self_comp_symm, image_id] } }

/-- The image of a compact set under a homeomorphism can also be expressed as a preimage. -/
lemma equiv_to_fun_val (f : α ≃ₜ β) (K : compacts α) :
  (compacts.equiv f K).1 = f.symm ⁻¹' K.1 :=
congr_fun (image_eq_preimage_of_inverse f.left_inv f.right_inv) K.1

end compacts

section nonempty_compacts
open topological_space set
variable {α}

instance nonempty_compacts.to_compact_space {p : nonempty_compacts α} : compact_space p.val :=
⟨is_compact_iff_is_compact_univ.1 p.property.2⟩

instance nonempty_compacts.to_nonempty {p : nonempty_compacts α} : nonempty p.val :=
p.property.1.to_subtype

/-- Associate to a nonempty compact subset the corresponding closed subset -/
def nonempty_compacts.to_closeds [t2_space α] : nonempty_compacts α → closeds α :=
set.inclusion $ λ s hs, hs.2.is_closed

end nonempty_compacts

section positive_compacts

variable (α)
/-- In a nonempty locally compact space, there exists a compact set with nonempty interior. -/
instance nonempty_positive_compacts [locally_compact_space α] [h : nonempty α] :
  nonempty (positive_compacts α) :=
let ⟨K, hK⟩ := exists_compact_subset is_open_univ $ mem_univ h.some in ⟨⟨K, hK.1, ⟨_, hK.2.1⟩⟩⟩

end positive_compacts

end topological_space


lemma lt_aux_one (a b : mynat) : a ≤ b ∧ ¬ (b ≤ a) → succ a ≤ b :=
begin
intro h,
cases h,
cases h_left,
cases h_left_w,

rw add_zero at h_left_h,
rw h_left_h at h_right,
exfalso,
exact h_right (le_refl a),

rw add_succ at h_left_h,
rw h_left_h,
use h_left_w,
rw succ_add,
refl,
end


/- Introduces matrices and horrifying linear algebra. -/

import sesh.context

open context
open debrujin_idx

/- For every variable (given by a debrujin idx), a matrix gives the context
   required by that variable. This is used when simultaneously substituting
   a bunch of terms for variables - the context required by the post-subst
   term will be Γ ⊛ Ξ, where Γ is the pre-subst context and Ξ defines the
   substitution. -/
def matrix (γ δ: precontext)
  : Type := Π (T: tp), γ ∋ T → context δ

namespace matrix

def identity: Π γ, matrix γ γ
| (T::_) _ (ZVar _ _) := ⟦1⬝T⟧::0
| (T::γ') U (SVar .(T) x) := ⟦0⬝T⟧::(identity γ' U x)

@[unfold_] lemma identity_zvar {T: τ} {γ: precontext}
  : identity (T::γ) T (ZVar _ T) = ⟦(1: mult)⬝T⟧::(0: context γ) := by refl

@[unfold_] lemma identity_svar {T U: τ} {δ: precontext} {x}
  : identity (T::δ) U (SVar T x) = ⟦(0: mult)⬝T⟧::(identity δ U x) := by refl

lemma identity_neq_zero {γ: precontext} {A: tp} {x: γ ∋ A}
  : identity γ A x ≠ 0 :=
begin
  intro h, unfold has_zero.zero at h, induction x,
  { simp [zeros] with unfold_ at h, cases h.left },
  case SVar : _ _ _ _ ih {
    simp [zeros, identity] at h, exact ih h },
end

def vmul: ∀ {γ δ}, context γ → matrix γ δ → context δ
| _ _ context.nil _ := 0
| (_::γ) _ (⟦π⬝T⟧::Γ) Ξ := (π • Ξ T (ZVar γ T)) + (vmul Γ (λ U x, Ξ U (SVar T x)))
infix ` ⊛ `:70 := vmul

/- Extend a matrix as the identity matrix – add a zero to the end of every row,
   and add a new row with a 1 and the rest 0s.-/
def ext {γ δ} (Ξ: matrix γ δ) (A: tp):
  matrix (A::γ) (A::δ)
| _ (ZVar _ _) := identity (A::δ) A (ZVar _ A)
| B (SVar _ x) := ⟦0⬝A⟧::(Ξ B x)

@[unfold_] lemma ext_zvar {γ δ} {Ξ: matrix γ δ} {A: tp}
  : ext Ξ A _ (ZVar _ _) = identity (A::δ) A (ZVar _ _) := by refl

@[unfold_] lemma ext_svar {γ δ} {Ξ: matrix γ δ} {A B: tp} {x: γ ∋ B}
  : ext Ξ A _ (SVar _ x) = ⟦0⬝A⟧::(Ξ _ x) := by refl

namespace vmul

@[simp] lemma vmul_nil {δ} {Ξ: matrix [] δ}
  : context.nil ⊛ Ξ = 0 := by refl

@[unfold_] lemma vmul_cons {γ δ} {T: τ} {Γ: context γ} {π: mult} {Ξ: matrix (T::γ) δ}
  : ⟦π⬝T⟧::Γ ⊛ Ξ = (π • Ξ T (ZVar _ T)) + (Γ ⊛ (λ U x, Ξ U (SVar T x))) :=
    by refl

@[simp] lemma zero_vmul
  : ∀ {γ δ: precontext} (M: matrix γ δ),
    0 ⊛ M = 0 :=
begin
  intros,
  induction γ with T γ ih,
  { refl },
  { unfold has_zero.zero zeros,
    simp * with unfold_,
    show ((0: mult) • M T (ZVar γ T) + 0 ⊛ λ (U : tp) (x : γ ∋ U), M U (SVar T x)) = 0,
    simp * },
end

@[simp] lemma vmul_ext_zero
  : ∀ {γ δ} {Γ: context γ} {Ξ: matrix γ δ} {T: τ},
    Γ ⊛ (λ U x, ⟦0⬝T⟧::(Ξ U x)) = ⟦0⬝T⟧::(Γ ⊛ Ξ) :=
begin
  intros,
  induction Γ with γ' π T' Γ ih,
  { refl },
  { simp * with unfold_ },
end

@[simp] lemma one_vmul
  : ∀ {γ δ} {Ξ: matrix γ δ} {T: τ}
    (x: γ ∋ T),
    -------------------------------
    (identity γ T x) ⊛ Ξ = Ξ T x :=
begin
  intros,
  induction x with γ' T' δ' T'' U x' ih;
  { simp * with unfold_ },
end

@[simp] lemma vmul_one
  : ∀ {γ} (Γ: context γ),
    Γ ⊛ (identity γ) = Γ :=
begin
  intros,
  induction Γ with γ π T Γ ih,
  { refl },
  { simp [*, vmul_ext_zero] with unfold_ },
end

lemma smul_vmul
  : ∀ {γ δ} {Γ: context γ} {Ξ: matrix γ δ} {π: mult},
    (π • Γ) ⊛ Ξ = π • (Γ ⊛ Ξ) :=
begin
  intros,
  induction Γ with γ' π' T Γ ih;
  { simp [*, context.mul_smul]
    with unfold_ sop_form },
end

@[sop_form] lemma vmul_right_distrib
  : ∀ {γ δ} {Γ₁ Γ₂: context γ} {Ξ: matrix γ δ},
    (Γ₁ + Γ₂) ⊛ Ξ = (Γ₁ ⊛ Ξ) + (Γ₂ ⊛ Ξ) :=
begin
  intros,
  induction Γ₁ with γ₁ π₁ T₁ Γ₁ ih₁;
  { cases Γ₂,
    simp * with unfold_ sop_form },
end

end vmul
open vmul

end matrix