/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

! This file was ported from Lean 3 source module data.stream.init
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Stream.Defs
import Mathbin.Tactic.Ext
import Mathbin.Logic.Function.Basic

/-!
# Streams a.k.a. infinite lists a.k.a. infinite sequences

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

This file used to be in the core library. It was moved to `mathlib` and renamed to `init` to avoid
name clashes.  -/

open Nat Function Option

universe u v w

namespace Stream'

variable {α : Type u} {β : Type v} {δ : Type w}

instance {α} [Inhabited α] : Inhabited (Stream' α) :=
  ⟨Stream'.const default⟩

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.eta /-
protected theorem eta (s : Stream' α) : (head s::tail s) = s :=
  funext fun i => by cases i <;> rfl
#align stream.eta Stream'.eta
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.nth_zero_cons /-
@[simp]
theorem nth_zero_cons (a : α) (s : Stream' α) : nth (a::s) 0 = a :=
  rfl
#align stream.nth_zero_cons Stream'.nth_zero_cons
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.head_cons /-
theorem head_cons (a : α) (s : Stream' α) : head (a::s) = a :=
  rfl
#align stream.head_cons Stream'.head_cons
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.tail_cons /-
theorem tail_cons (a : α) (s : Stream' α) : tail (a::s) = s :=
  rfl
#align stream.tail_cons Stream'.tail_cons
-/

#print Stream'.tail_drop /-
theorem tail_drop (n : Nat) (s : Stream' α) : tail (drop n s) = drop n (tail s) :=
  funext fun i => by unfold tail drop; simp [nth, Nat.add_comm, Nat.add_left_comm]
#align stream.tail_drop Stream'.tail_drop
-/

#print Stream'.nth_drop /-
theorem nth_drop (n m : Nat) (s : Stream' α) : nth (drop m s) n = nth s (n + m) :=
  rfl
#align stream.nth_drop Stream'.nth_drop
-/

#print Stream'.tail_eq_drop /-
theorem tail_eq_drop (s : Stream' α) : tail s = drop 1 s :=
  rfl
#align stream.tail_eq_drop Stream'.tail_eq_drop
-/

#print Stream'.drop_drop /-
theorem drop_drop (n m : Nat) (s : Stream' α) : drop n (drop m s) = drop (n + m) s :=
  funext fun i => by unfold drop; rw [Nat.add_assoc]
#align stream.drop_drop Stream'.drop_drop
-/

#print Stream'.nth_succ /-
theorem nth_succ (n : Nat) (s : Stream' α) : nth s (succ n) = nth (tail s) n :=
  rfl
#align stream.nth_succ Stream'.nth_succ
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.nth_succ_cons /-
@[simp]
theorem nth_succ_cons (n : Nat) (s : Stream' α) (x : α) : nth (x::s) n.succ = nth s n :=
  rfl
#align stream.nth_succ_cons Stream'.nth_succ_cons
-/

#print Stream'.drop_succ /-
theorem drop_succ (n : Nat) (s : Stream' α) : drop (succ n) s = drop n (tail s) :=
  rfl
#align stream.drop_succ Stream'.drop_succ
-/

#print Stream'.head_drop /-
@[simp]
theorem head_drop {α} (a : Stream' α) (n : ℕ) : (a.drop n).headI = a.get? n := by
  simp only [drop, head, Nat.zero_add, Stream'.nth]
#align stream.head_drop Stream'.head_drop
-/

#print Stream'.ext /-
@[ext]
protected theorem ext {s₁ s₂ : Stream' α} : (∀ n, nth s₁ n = nth s₂ n) → s₁ = s₂ := fun h =>
  funext h
#align stream.ext Stream'.ext
-/

#print Stream'.cons_injective2 /-
theorem cons_injective2 : Function.Injective2 (cons : α → Stream' α → Stream' α) := fun x y s t h =>
  ⟨by rw [← nth_zero_cons x s, h, nth_zero_cons],
    Stream'.ext fun n => by rw [← nth_succ_cons n _ x, h, nth_succ_cons]⟩
#align stream.cons_injective2 Stream'.cons_injective2
-/

#print Stream'.cons_injective_left /-
theorem cons_injective_left (s : Stream' α) : Function.Injective fun x => cons x s :=
  cons_injective2.left _
#align stream.cons_injective_left Stream'.cons_injective_left
-/

#print Stream'.cons_injective_right /-
theorem cons_injective_right (x : α) : Function.Injective (cons x) :=
  cons_injective2.right _
#align stream.cons_injective_right Stream'.cons_injective_right
-/

#print Stream'.all_def /-
theorem all_def (p : α → Prop) (s : Stream' α) : All p s = ∀ n, p (nth s n) :=
  rfl
#align stream.all_def Stream'.all_def
-/

#print Stream'.any_def /-
theorem any_def (p : α → Prop) (s : Stream' α) : Any p s = ∃ n, p (nth s n) :=
  rfl
#align stream.any_def Stream'.any_def
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.mem_cons /-
theorem mem_cons (a : α) (s : Stream' α) : a ∈ a::s :=
  Exists.intro 0 rfl
#align stream.mem_cons Stream'.mem_cons
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.mem_cons_of_mem /-
theorem mem_cons_of_mem {a : α} {s : Stream' α} (b : α) : a ∈ s → a ∈ b::s := fun ⟨n, h⟩ =>
  Exists.intro (succ n) (by rw [nth_succ, tail_cons, h])
#align stream.mem_cons_of_mem Stream'.mem_cons_of_mem
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.eq_or_mem_of_mem_cons /-
theorem eq_or_mem_of_mem_cons {a b : α} {s : Stream' α} : (a ∈ b::s) → a = b ∨ a ∈ s :=
  fun ⟨n, h⟩ => by
  cases' n with n'
  · left
    exact h
  · right
    rw [nth_succ, tail_cons] at h
    exact ⟨n', h⟩
#align stream.eq_or_mem_of_mem_cons Stream'.eq_or_mem_of_mem_cons
-/

#print Stream'.mem_of_nth_eq /-
theorem mem_of_nth_eq {n : Nat} {s : Stream' α} {a : α} : a = nth s n → a ∈ s := fun h =>
  Exists.intro n h
#align stream.mem_of_nth_eq Stream'.mem_of_nth_eq
-/

section Map

variable (f : α → β)

#print Stream'.drop_map /-
theorem drop_map (n : Nat) (s : Stream' α) : drop n (map f s) = map f (drop n s) :=
  Stream'.ext fun i => rfl
#align stream.drop_map Stream'.drop_map
-/

#print Stream'.nth_map /-
theorem nth_map (n : Nat) (s : Stream' α) : nth (map f s) n = f (nth s n) :=
  rfl
#align stream.nth_map Stream'.nth_map
-/

#print Stream'.tail_map /-
theorem tail_map (s : Stream' α) : tail (map f s) = map f (tail s) := by rw [tail_eq_drop]; rfl
#align stream.tail_map Stream'.tail_map
-/

#print Stream'.head_map /-
theorem head_map (s : Stream' α) : head (map f s) = f (head s) :=
  rfl
#align stream.head_map Stream'.head_map
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.map_eq /-
theorem map_eq (s : Stream' α) : map f s = f (head s)::map f (tail s) := by
  rw [← Stream'.eta (map f s), tail_map, head_map]
#align stream.map_eq Stream'.map_eq
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.map_cons /-
theorem map_cons (a : α) (s : Stream' α) : map f (a::s) = f a::map f s := by
  rw [← Stream'.eta (map f (a::s)), map_eq]; rfl
#align stream.map_cons Stream'.map_cons
-/

#print Stream'.map_id /-
theorem map_id (s : Stream' α) : map id s = s :=
  rfl
#align stream.map_id Stream'.map_id
-/

#print Stream'.map_map /-
theorem map_map (g : β → δ) (f : α → β) (s : Stream' α) : map g (map f s) = map (g ∘ f) s :=
  rfl
#align stream.map_map Stream'.map_map
-/

#print Stream'.map_tail /-
theorem map_tail (s : Stream' α) : map f (tail s) = tail (map f s) :=
  rfl
#align stream.map_tail Stream'.map_tail
-/

#print Stream'.mem_map /-
theorem mem_map {a : α} {s : Stream' α} : a ∈ s → f a ∈ map f s := fun ⟨n, h⟩ =>
  Exists.intro n (by rw [nth_map, h])
#align stream.mem_map Stream'.mem_map
-/

#print Stream'.exists_of_mem_map /-
theorem exists_of_mem_map {f} {b : β} {s : Stream' α} : b ∈ map f s → ∃ a, a ∈ s ∧ f a = b :=
  fun ⟨n, h⟩ => ⟨nth s n, ⟨n, rfl⟩, h.symm⟩
#align stream.exists_of_mem_map Stream'.exists_of_mem_map
-/

end Map

section Zip

variable (f : α → β → δ)

#print Stream'.drop_zip /-
theorem drop_zip (n : Nat) (s₁ : Stream' α) (s₂ : Stream' β) :
    drop n (zip f s₁ s₂) = zip f (drop n s₁) (drop n s₂) :=
  Stream'.ext fun i => rfl
#align stream.drop_zip Stream'.drop_zip
-/

#print Stream'.nth_zip /-
theorem nth_zip (n : Nat) (s₁ : Stream' α) (s₂ : Stream' β) :
    nth (zip f s₁ s₂) n = f (nth s₁ n) (nth s₂ n) :=
  rfl
#align stream.nth_zip Stream'.nth_zip
-/

#print Stream'.head_zip /-
theorem head_zip (s₁ : Stream' α) (s₂ : Stream' β) : head (zip f s₁ s₂) = f (head s₁) (head s₂) :=
  rfl
#align stream.head_zip Stream'.head_zip
-/

#print Stream'.tail_zip /-
theorem tail_zip (s₁ : Stream' α) (s₂ : Stream' β) :
    tail (zip f s₁ s₂) = zip f (tail s₁) (tail s₂) :=
  rfl
#align stream.tail_zip Stream'.tail_zip
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.zip_eq /-
theorem zip_eq (s₁ : Stream' α) (s₂ : Stream' β) :
    zip f s₁ s₂ = f (head s₁) (head s₂)::zip f (tail s₁) (tail s₂) := by
  rw [← Stream'.eta (zip f s₁ s₂)]; rfl
#align stream.zip_eq Stream'.zip_eq
-/

#print Stream'.nth_enum /-
@[simp]
theorem nth_enum (s : Stream' α) (n : ℕ) : nth (enum s) n = (n, s.get? n) :=
  rfl
#align stream.nth_enum Stream'.nth_enum
-/

#print Stream'.enum_eq_zip /-
theorem enum_eq_zip (s : Stream' α) : enum s = zip Prod.mk nats s :=
  rfl
#align stream.enum_eq_zip Stream'.enum_eq_zip
-/

end Zip

#print Stream'.mem_const /-
theorem mem_const (a : α) : a ∈ const a :=
  Exists.intro 0 rfl
#align stream.mem_const Stream'.mem_const
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.const_eq /-
theorem const_eq (a : α) : const a = a::const a :=
  by
  apply Stream'.ext; intro n
  cases n <;> rfl
#align stream.const_eq Stream'.const_eq
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.tail_const /-
theorem tail_const (a : α) : tail (const a) = const a :=
  suffices tail (a::const a) = const a by rwa [← const_eq] at this
  rfl
#align stream.tail_const Stream'.tail_const
-/

#print Stream'.map_const /-
theorem map_const (f : α → β) (a : α) : map f (const a) = const (f a) :=
  rfl
#align stream.map_const Stream'.map_const
-/

#print Stream'.nth_const /-
theorem nth_const (n : Nat) (a : α) : nth (const a) n = a :=
  rfl
#align stream.nth_const Stream'.nth_const
-/

#print Stream'.drop_const /-
theorem drop_const (n : Nat) (a : α) : drop n (const a) = const a :=
  Stream'.ext fun i => rfl
#align stream.drop_const Stream'.drop_const
-/

#print Stream'.head_iterate /-
theorem head_iterate (f : α → α) (a : α) : head (iterate f a) = a :=
  rfl
#align stream.head_iterate Stream'.head_iterate
-/

#print Stream'.tail_iterate /-
theorem tail_iterate (f : α → α) (a : α) : tail (iterate f a) = iterate f (f a) :=
  by
  funext n
  induction' n with n' ih
  · rfl
  · unfold tail iterate
    unfold tail iterate at ih
    rw [add_one] at ih
    dsimp at ih
    rw [add_one]
    dsimp
    rw [ih]
#align stream.tail_iterate Stream'.tail_iterate
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.iterate_eq /-
theorem iterate_eq (f : α → α) (a : α) : iterate f a = a::iterate f (f a) :=
  by
  rw [← Stream'.eta (iterate f a)]
  rw [tail_iterate]; rfl
#align stream.iterate_eq Stream'.iterate_eq
-/

#print Stream'.nth_zero_iterate /-
theorem nth_zero_iterate (f : α → α) (a : α) : nth (iterate f a) 0 = a :=
  rfl
#align stream.nth_zero_iterate Stream'.nth_zero_iterate
-/

#print Stream'.nth_succ_iterate /-
theorem nth_succ_iterate (n : Nat) (f : α → α) (a : α) :
    nth (iterate f a) (succ n) = nth (iterate f (f a)) n := by rw [nth_succ, tail_iterate]
#align stream.nth_succ_iterate Stream'.nth_succ_iterate
-/

section Bisim

variable (R : Stream' α → Stream' α → Prop)

-- mathport name: «expr ~ »
local infixl:50 " ~ " => R

#print Stream'.IsBisimulation /-
def IsBisimulation :=
  ∀ ⦃s₁ s₂⦄, s₁ ~ s₂ → head s₁ = head s₂ ∧ tail s₁ ~ tail s₂
#align stream.is_bisimulation Stream'.IsBisimulation
-/

#print Stream'.nth_of_bisim /-
theorem nth_of_bisim (bisim : IsBisimulation R) :
    ∀ {s₁ s₂} (n), s₁ ~ s₂ → nth s₁ n = nth s₂ n ∧ drop (n + 1) s₁ ~ drop (n + 1) s₂
  | s₁, s₂, 0, h => bisim h
  | s₁, s₂, n + 1, h =>
    match bisim h with
    | ⟨h₁, trel⟩ => nth_of_bisim n trel
#align stream.nth_of_bisim Stream'.nth_of_bisim
-/

#print Stream'.eq_of_bisim /-
-- If two streams are bisimilar, then they are equal
theorem eq_of_bisim (bisim : IsBisimulation R) : ∀ {s₁ s₂}, s₁ ~ s₂ → s₁ = s₂ := fun s₁ s₂ r =>
  Stream'.ext fun n => And.left (nth_of_bisim R bisim n r)
#align stream.eq_of_bisim Stream'.eq_of_bisim
-/

end Bisim

#print Stream'.bisim_simple /-
theorem bisim_simple (s₁ s₂ : Stream' α) :
    head s₁ = head s₂ → s₁ = tail s₁ → s₂ = tail s₂ → s₁ = s₂ := fun hh ht₁ ht₂ =>
  eq_of_bisim (fun s₁ s₂ => head s₁ = head s₂ ∧ s₁ = tail s₁ ∧ s₂ = tail s₂)
    (fun s₁ s₂ ⟨h₁, h₂, h₃⟩ => by constructor; exact h₁; rw [← h₂, ← h₃];
      repeat' constructor <;> assumption)
    (And.intro hh (And.intro ht₁ ht₂))
#align stream.bisim_simple Stream'.bisim_simple
-/

#print Stream'.coinduction /-
theorem coinduction {s₁ s₂ : Stream' α} :
    head s₁ = head s₂ →
      (∀ (β : Type u) (fr : Stream' α → β), fr s₁ = fr s₂ → fr (tail s₁) = fr (tail s₂)) →
        s₁ = s₂ :=
  fun hh ht =>
  eq_of_bisim
    (fun s₁ s₂ =>
      head s₁ = head s₂ ∧
        ∀ (β : Type u) (fr : Stream' α → β), fr s₁ = fr s₂ → fr (tail s₁) = fr (tail s₂))
    (fun s₁ s₂ h =>
      have h₁ : head s₁ = head s₂ := And.left h
      have h₂ : head (tail s₁) = head (tail s₂) := And.right h α (@head α) h₁
      have h₃ :
        ∀ (β : Type u) (fr : Stream' α → β),
          fr (tail s₁) = fr (tail s₂) → fr (tail (tail s₁)) = fr (tail (tail s₂)) :=
        fun β fr => And.right h β fun s => fr (tail s)
      And.intro h₁ (And.intro h₂ h₃))
    (And.intro hh ht)
#align stream.coinduction Stream'.coinduction
-/

#print Stream'.iterate_id /-
theorem iterate_id (a : α) : iterate id a = const a :=
  coinduction rfl fun β fr ch => by rw [tail_iterate, tail_const]; exact ch
#align stream.iterate_id Stream'.iterate_id
-/

attribute [local reducible] Stream'

#print Stream'.map_iterate /-
theorem map_iterate (f : α → α) (a : α) : iterate f (f a) = map f (iterate f a) :=
  by
  funext n
  induction' n with n' ih
  · rfl
  · unfold map iterate nth
    dsimp
    unfold map iterate nth at ih
    dsimp at ih
    rw [ih]
#align stream.map_iterate Stream'.map_iterate
-/

section Corec

#print Stream'.corec_def /-
theorem corec_def (f : α → β) (g : α → α) (a : α) : corec f g a = map f (iterate g a) :=
  rfl
#align stream.corec_def Stream'.corec_def
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.corec_eq /-
theorem corec_eq (f : α → β) (g : α → α) (a : α) : corec f g a = f a::corec f g (g a) := by
  rw [corec_def, map_eq, head_iterate, tail_iterate]; rfl
#align stream.corec_eq Stream'.corec_eq
-/

#print Stream'.corec_id_id_eq_const /-
theorem corec_id_id_eq_const (a : α) : corec id id a = const a := by
  rw [corec_def, map_id, iterate_id]
#align stream.corec_id_id_eq_const Stream'.corec_id_id_eq_const
-/

#print Stream'.corec_id_f_eq_iterate /-
theorem corec_id_f_eq_iterate (f : α → α) (a : α) : corec id f a = iterate f a :=
  rfl
#align stream.corec_id_f_eq_iterate Stream'.corec_id_f_eq_iterate
-/

end Corec

section Corec'

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.corec'_eq /-
theorem corec'_eq (f : α → β × α) (a : α) : corec' f a = (f a).1::corec' f (f a).2 :=
  corec_eq _ _ _
#align stream.corec'_eq Stream'.corec'_eq
-/

end Corec'

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.unfolds_eq /-
theorem unfolds_eq (g : α → β) (f : α → α) (a : α) : unfolds g f a = g a::unfolds g f (f a) := by
  unfold unfolds; rw [corec_eq]
#align stream.unfolds_eq Stream'.unfolds_eq
-/

#print Stream'.nth_unfolds_head_tail /-
theorem nth_unfolds_head_tail :
    ∀ (n : Nat) (s : Stream' α), nth (unfolds head tail s) n = nth s n :=
  by
  intro n; induction' n with n' ih
  · intro s
    rfl
  · intro s
    rw [nth_succ, nth_succ, unfolds_eq, tail_cons, ih]
#align stream.nth_unfolds_head_tail Stream'.nth_unfolds_head_tail
-/

#print Stream'.unfolds_head_eq /-
theorem unfolds_head_eq : ∀ s : Stream' α, unfolds head tail s = s := fun s =>
  Stream'.ext fun n => nth_unfolds_head_tail n s
#align stream.unfolds_head_eq Stream'.unfolds_head_eq
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.interleave_eq /-
theorem interleave_eq (s₁ s₂ : Stream' α) : s₁ ⋈ s₂ = head s₁::head s₂::tail s₁ ⋈ tail s₂ := by
  unfold interleave corec_on; rw [corec_eq]; dsimp; rw [corec_eq]; rfl
#align stream.interleave_eq Stream'.interleave_eq
-/

#print Stream'.tail_interleave /-
theorem tail_interleave (s₁ s₂ : Stream' α) : tail (s₁ ⋈ s₂) = s₂ ⋈ tail s₁ := by
  unfold interleave corec_on; rw [corec_eq]; rfl
#align stream.tail_interleave Stream'.tail_interleave
-/

#print Stream'.interleave_tail_tail /-
theorem interleave_tail_tail (s₁ s₂ : Stream' α) : tail s₁ ⋈ tail s₂ = tail (tail (s₁ ⋈ s₂)) := by
  rw [interleave_eq s₁ s₂]; rfl
#align stream.interleave_tail_tail Stream'.interleave_tail_tail
-/

#print Stream'.nth_interleave_left /-
theorem nth_interleave_left : ∀ (n : Nat) (s₁ s₂ : Stream' α), nth (s₁ ⋈ s₂) (2 * n) = nth s₁ n
  | 0, s₁, s₂ => rfl
  | succ n, s₁, s₂ =>
    by
    change nth (s₁ ⋈ s₂) (succ (succ (2 * n))) = nth s₁ (succ n)
    rw [nth_succ, nth_succ, interleave_eq, tail_cons, tail_cons, nth_interleave_left]
    rfl
#align stream.nth_interleave_left Stream'.nth_interleave_left
-/

#print Stream'.nth_interleave_right /-
theorem nth_interleave_right : ∀ (n : Nat) (s₁ s₂ : Stream' α), nth (s₁ ⋈ s₂) (2 * n + 1) = nth s₂ n
  | 0, s₁, s₂ => rfl
  | succ n, s₁, s₂ =>
    by
    change nth (s₁ ⋈ s₂) (succ (succ (2 * n + 1))) = nth s₂ (succ n)
    rw [nth_succ, nth_succ, interleave_eq, tail_cons, tail_cons, nth_interleave_right]
    rfl
#align stream.nth_interleave_right Stream'.nth_interleave_right
-/

#print Stream'.mem_interleave_left /-
theorem mem_interleave_left {a : α} {s₁ : Stream' α} (s₂ : Stream' α) : a ∈ s₁ → a ∈ s₁ ⋈ s₂ :=
  fun ⟨n, h⟩ => Exists.intro (2 * n) (by rw [h, nth_interleave_left])
#align stream.mem_interleave_left Stream'.mem_interleave_left
-/

#print Stream'.mem_interleave_right /-
theorem mem_interleave_right {a : α} {s₁ : Stream' α} (s₂ : Stream' α) : a ∈ s₂ → a ∈ s₁ ⋈ s₂ :=
  fun ⟨n, h⟩ => Exists.intro (2 * n + 1) (by rw [h, nth_interleave_right])
#align stream.mem_interleave_right Stream'.mem_interleave_right
-/

#print Stream'.odd_eq /-
theorem odd_eq (s : Stream' α) : odd s = even (tail s) :=
  rfl
#align stream.odd_eq Stream'.odd_eq
-/

#print Stream'.head_even /-
theorem head_even (s : Stream' α) : head (even s) = head s :=
  rfl
#align stream.head_even Stream'.head_even
-/

#print Stream'.tail_even /-
theorem tail_even (s : Stream' α) : tail (even s) = even (tail (tail s)) := by unfold Even;
  rw [corec_eq]; rfl
#align stream.tail_even Stream'.tail_even
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.even_cons_cons /-
theorem even_cons_cons (a₁ a₂ : α) (s : Stream' α) : even (a₁::a₂::s) = a₁::even s := by
  unfold Even; rw [corec_eq]; rfl
#align stream.even_cons_cons Stream'.even_cons_cons
-/

#print Stream'.even_tail /-
theorem even_tail (s : Stream' α) : even (tail s) = odd s :=
  rfl
#align stream.even_tail Stream'.even_tail
-/

#print Stream'.even_interleave /-
theorem even_interleave (s₁ s₂ : Stream' α) : even (s₁ ⋈ s₂) = s₁ :=
  eq_of_bisim (fun s₁' s₁ => ∃ s₂, s₁' = even (s₁ ⋈ s₂))
    (fun s₁' s₁ ⟨s₂, h₁⟩ => by
      rw [h₁]
      constructor
      · rfl
      · exact ⟨tail s₂, by rw [interleave_eq, even_cons_cons, tail_cons]⟩)
    (Exists.intro s₂ rfl)
#align stream.even_interleave Stream'.even_interleave
-/

#print Stream'.interleave_even_odd /-
theorem interleave_even_odd (s₁ : Stream' α) : even s₁ ⋈ odd s₁ = s₁ :=
  eq_of_bisim (fun s' s => s' = even s ⋈ odd s)
    (fun s' s (h : s' = even s ⋈ odd s) => by
      rw [h]; constructor
      · rfl
      · simp [odd_eq, odd_eq, tail_interleave, tail_even])
    rfl
#align stream.interleave_even_odd Stream'.interleave_even_odd
-/

#print Stream'.nth_even /-
theorem nth_even : ∀ (n : Nat) (s : Stream' α), nth (even s) n = nth s (2 * n)
  | 0, s => rfl
  | succ n, s => by
    change nth (Even s) (succ n) = nth s (succ (succ (2 * n)))
    rw [nth_succ, nth_succ, tail_even, nth_even]; rfl
#align stream.nth_even Stream'.nth_even
-/

#print Stream'.nth_odd /-
theorem nth_odd : ∀ (n : Nat) (s : Stream' α), nth (odd s) n = nth s (2 * n + 1) := fun n s => by
  rw [odd_eq, nth_even]; rfl
#align stream.nth_odd Stream'.nth_odd
-/

#print Stream'.mem_of_mem_even /-
theorem mem_of_mem_even (a : α) (s : Stream' α) : a ∈ even s → a ∈ s := fun ⟨n, h⟩ =>
  Exists.intro (2 * n) (by rw [h, nth_even])
#align stream.mem_of_mem_even Stream'.mem_of_mem_even
-/

#print Stream'.mem_of_mem_odd /-
theorem mem_of_mem_odd (a : α) (s : Stream' α) : a ∈ odd s → a ∈ s := fun ⟨n, h⟩ =>
  Exists.intro (2 * n + 1) (by rw [h, nth_odd])
#align stream.mem_of_mem_odd Stream'.mem_of_mem_odd
-/

#print Stream'.nil_append_stream /-
theorem nil_append_stream (s : Stream' α) : appendStream' [] s = s :=
  rfl
#align stream.nil_append_stream Stream'.nil_append_stream
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.cons_append_stream /-
theorem cons_append_stream (a : α) (l : List α) (s : Stream' α) :
    appendStream' (a::l) s = a::appendStream' l s :=
  rfl
#align stream.cons_append_stream Stream'.cons_append_stream
-/

#print Stream'.append_append_stream /-
theorem append_append_stream :
    ∀ (l₁ l₂ : List α) (s : Stream' α), l₁ ++ l₂ ++ₛ s = l₁ ++ₛ (l₂ ++ₛ s)
  | [], l₂, s => rfl
  | List.cons a l₁, l₂, s => by
    rw [List.cons_append, cons_append_stream, cons_append_stream, append_append_stream]
#align stream.append_append_stream Stream'.append_append_stream
-/

#print Stream'.map_append_stream /-
theorem map_append_stream (f : α → β) :
    ∀ (l : List α) (s : Stream' α), map f (l ++ₛ s) = List.map f l ++ₛ map f s
  | [], s => rfl
  | List.cons a l, s => by
    rw [cons_append_stream, List.map_cons, map_cons, cons_append_stream, map_append_stream]
#align stream.map_append_stream Stream'.map_append_stream
-/

#print Stream'.drop_append_stream /-
theorem drop_append_stream : ∀ (l : List α) (s : Stream' α), drop l.length (l ++ₛ s) = s
  | [], s => by rfl
  | List.cons a l, s => by
    rw [List.length_cons, add_one, drop_succ, cons_append_stream, tail_cons, drop_append_stream]
#align stream.drop_append_stream Stream'.drop_append_stream
-/

#print Stream'.append_stream_head_tail /-
theorem append_stream_head_tail (s : Stream' α) : [head s] ++ₛ tail s = s := by
  rw [cons_append_stream, nil_append_stream, Stream'.eta]
#align stream.append_stream_head_tail Stream'.append_stream_head_tail
-/

#print Stream'.mem_append_stream_right /-
theorem mem_append_stream_right : ∀ {a : α} (l : List α) {s : Stream' α}, a ∈ s → a ∈ l ++ₛ s
  | a, [], s, h => h
  | a, List.cons b l, s, h =>
    have ih : a ∈ l ++ₛ s := mem_append_stream_right l h
    mem_cons_of_mem _ ih
#align stream.mem_append_stream_right Stream'.mem_append_stream_right
-/

#print Stream'.mem_append_stream_left /-
theorem mem_append_stream_left : ∀ {a : α} {l : List α} (s : Stream' α), a ∈ l → a ∈ l ++ₛ s
  | a, [], s, h => absurd h (List.not_mem_nil _)
  | a, List.cons b l, s, h =>
    Or.elim (List.eq_or_mem_of_mem_cons h) (fun aeqb : a = b => Exists.intro 0 aeqb)
      fun ainl : a ∈ l => mem_cons_of_mem b (mem_append_stream_left s ainl)
#align stream.mem_append_stream_left Stream'.mem_append_stream_left
-/

#print Stream'.take_zero /-
@[simp]
theorem take_zero (s : Stream' α) : take 0 s = [] :=
  rfl
#align stream.take_zero Stream'.take_zero
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.take_succ /-
@[simp]
theorem take_succ (n : Nat) (s : Stream' α) : take (succ n) s = head s::take n (tail s) :=
  rfl
#align stream.take_succ Stream'.take_succ
-/

#print Stream'.length_take /-
@[simp]
theorem length_take (n : ℕ) (s : Stream' α) : (take n s).length = n := by
  induction n generalizing s <;> simp [*]
#align stream.length_take Stream'.length_take
-/

#print Stream'.get?_take_succ /-
theorem get?_take_succ : ∀ (n : Nat) (s : Stream' α), List.get? (take (succ n) s) n = some (nth s n)
  | 0, s => rfl
  | n + 1, s => by rw [take_succ, add_one, List.get?, nth_take_succ]; rfl
#align stream.nth_take_succ Stream'.get?_take_succ
-/

#print Stream'.append_take_drop /-
theorem append_take_drop : ∀ (n : Nat) (s : Stream' α), appendStream' (take n s) (drop n s) = s :=
  by
  intro n
  induction' n with n' ih
  · intro s
    rfl
  · intro s
    rw [take_succ, drop_succ, cons_append_stream, ih (tail s), Stream'.eta]
#align stream.append_take_drop Stream'.append_take_drop
-/

#print Stream'.take_theorem /-
-- Take theorem reduces a proof of equality of infinite streams to an
-- induction over all their finite approximations.
theorem take_theorem (s₁ s₂ : Stream' α) : (∀ n : Nat, take n s₁ = take n s₂) → s₁ = s₂ :=
  by
  intro h; apply Stream'.ext; intro n
  induction' n with n ih
  · have aux := h 1
    simp [take] at aux
    exact aux
  · have h₁ : some (nth s₁ (succ n)) = some (nth s₂ (succ n)) := by
      rw [← nth_take_succ, ← nth_take_succ, h (succ (succ n))]
    injection h₁
#align stream.take_theorem Stream'.take_theorem
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.cycle_g_cons /-
protected theorem cycle_g_cons (a : α) (a₁ : α) (l₁ : List α) (a₀ : α) (l₀ : List α) :
    Stream'.cycleG (a, a₁::l₁, a₀, l₀) = (a₁, l₁, a₀, l₀) :=
  rfl
#align stream.cycle_g_cons Stream'.cycle_g_cons
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.cycle_eq /-
theorem cycle_eq : ∀ (l : List α) (h : l ≠ []), cycle l h = l ++ₛ cycle l h
  | [], h => absurd rfl h
  | List.cons a l, h =>
    have gen :
      ∀ l' a',
        corec Stream'.cycleF Stream'.cycleG (a', l', a, l) =
          (a'::l') ++ₛ corec Stream'.cycleF Stream'.cycleG (a, l, a, l) :=
      by
      intro l'
      induction' l' with a₁ l₁ ih
      · intros
        rw [corec_eq]
        rfl
      · intros
        rw [corec_eq, Stream'.cycle_g_cons, ih a₁]
        rfl
    gen l a
#align stream.cycle_eq Stream'.cycle_eq
-/

#print Stream'.mem_cycle /-
theorem mem_cycle {a : α} {l : List α} : ∀ h : l ≠ [], a ∈ l → a ∈ cycle l h := fun h ainl => by
  rw [cycle_eq]; exact mem_append_stream_left _ ainl
#align stream.mem_cycle Stream'.mem_cycle
-/

#print Stream'.cycle_singleton /-
theorem cycle_singleton (a : α) (h : [a] ≠ []) : cycle [a] h = const a :=
  coinduction rfl fun β fr ch => by rwa [cycle_eq, const_eq]
#align stream.cycle_singleton Stream'.cycle_singleton
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.tails_eq /-
theorem tails_eq (s : Stream' α) : tails s = tail s::tails (tail s) := by
  unfold tails <;> rw [corec_eq] <;> rfl
#align stream.tails_eq Stream'.tails_eq
-/

#print Stream'.nth_tails /-
theorem nth_tails : ∀ (n : Nat) (s : Stream' α), nth (tails s) n = drop n (tail s) :=
  by
  intro n; induction' n with n' ih
  · intros
    rfl
  · intro s
    rw [nth_succ, drop_succ, tails_eq, tail_cons, ih]
#align stream.nth_tails Stream'.nth_tails
-/

#print Stream'.tails_eq_iterate /-
theorem tails_eq_iterate (s : Stream' α) : tails s = iterate tail (tail s) :=
  rfl
#align stream.tails_eq_iterate Stream'.tails_eq_iterate
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.inits_core_eq /-
theorem inits_core_eq (l : List α) (s : Stream' α) :
    initsCore l s = l::initsCore (l ++ [head s]) (tail s) := by unfold inits_core corec_on;
  rw [corec_eq]; rfl
#align stream.inits_core_eq Stream'.inits_core_eq
-/

#print Stream'.tail_inits /-
theorem tail_inits (s : Stream' α) :
    tail (inits s) = initsCore [head s, head (tail s)] (tail (tail s)) := by unfold inits;
  rw [inits_core_eq]; rfl
#align stream.tail_inits Stream'.tail_inits
-/

#print Stream'.inits_tail /-
theorem inits_tail (s : Stream' α) : inits (tail s) = initsCore [head (tail s)] (tail (tail s)) :=
  rfl
#align stream.inits_tail Stream'.inits_tail
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.cons_nth_inits_core /-
theorem cons_nth_inits_core :
    ∀ (a : α) (n : Nat) (l : List α) (s : Stream' α),
      (a::nth (initsCore l s) n) = nth (initsCore (a::l) s) n :=
  by
  intro a n
  induction' n with n' ih
  · intros
    rfl
  · intro l s
    rw [nth_succ, inits_core_eq, tail_cons, ih, inits_core_eq (a::l) s]
    rfl
#align stream.cons_nth_inits_core Stream'.cons_nth_inits_core
-/

#print Stream'.nth_inits /-
theorem nth_inits : ∀ (n : Nat) (s : Stream' α), nth (inits s) n = take (succ n) s :=
  by
  intro n; induction' n with n' ih
  · intros
    rfl
  · intros
    rw [nth_succ, take_succ, ← ih, tail_inits, inits_tail, cons_nth_inits_core]
#align stream.nth_inits Stream'.nth_inits
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.inits_eq /-
theorem inits_eq (s : Stream' α) : inits s = [head s]::map (List.cons (head s)) (inits (tail s)) :=
  by
  apply Stream'.ext; intro n
  cases n
  · rfl
  · rw [nth_inits, nth_succ, tail_cons, nth_map, nth_inits]
    rfl
#align stream.inits_eq Stream'.inits_eq
-/

#print Stream'.zip_inits_tails /-
theorem zip_inits_tails (s : Stream' α) : zip appendStream' (inits s) (tails s) = const s :=
  by
  apply Stream'.ext; intro n
  rw [nth_zip, nth_inits, nth_tails, nth_const, take_succ, cons_append_stream, append_take_drop,
    Stream'.eta]
#align stream.zip_inits_tails Stream'.zip_inits_tails
-/

#print Stream'.identity /-
theorem identity (s : Stream' α) : pure id ⊛ s = s :=
  rfl
#align stream.identity Stream'.identity
-/

#print Stream'.composition /-
theorem composition (g : Stream' (β → δ)) (f : Stream' (α → β)) (s : Stream' α) :
    pure comp ⊛ g ⊛ f ⊛ s = g ⊛ (f ⊛ s) :=
  rfl
#align stream.composition Stream'.composition
-/

#print Stream'.homomorphism /-
theorem homomorphism (f : α → β) (a : α) : pure f ⊛ pure a = pure (f a) :=
  rfl
#align stream.homomorphism Stream'.homomorphism
-/

#print Stream'.interchange /-
theorem interchange (fs : Stream' (α → β)) (a : α) :
    fs ⊛ pure a = (pure fun f : α → β => f a) ⊛ fs :=
  rfl
#align stream.interchange Stream'.interchange
-/

#print Stream'.map_eq_apply /-
theorem map_eq_apply (f : α → β) (s : Stream' α) : map f s = pure f ⊛ s :=
  rfl
#align stream.map_eq_apply Stream'.map_eq_apply
-/

#print Stream'.nth_nats /-
theorem nth_nats (n : Nat) : nth nats n = n :=
  rfl
#align stream.nth_nats Stream'.nth_nats
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print Stream'.nats_eq /-
theorem nats_eq : nats = 0::map succ nats :=
  by
  apply Stream'.ext; intro n
  cases n; rfl; rw [nth_succ]; rfl
#align stream.nats_eq Stream'.nats_eq
-/

end Stream'


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

open category_theory category_theory.limits

noncomputable theory

namespace category_theory

universes v u₁ u₂ u₃

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

section creates
variables {D : Type u₂} [category.{v} D]

variables {J : Type v} [small_category J] {K : J ⥤ C}

/--
Define the lift of a cone: For a cone `c` for `K ⋙ F`, give a cone for `K`
which is a lift of `c`, i.e. the image of it under `F` is (iso) to `c`.

We will then use this as part of the definition of creation of limits:
every limit cone has a lift.

Note this definition is really only useful when `c` is a limit already.
-/
structure liftable_cone (K : J ⥤ C) (F : C ⥤ D) (c : cone (K ⋙ F)) :=
(lifted_cone : cone K)
(valid_lift : F.map_cone lifted_cone ≅ c)

/--
Define the lift of a cocone: For a cocone `c` for `K ⋙ F`, give a cocone for
`K` which is a lift of `c`, i.e. the image of it under `F` is (iso) to `c`.

We will then use this as part of the definition of creation of colimits:
every limit cocone has a lift.

Note this definition is really only useful when `c` is a colimit already.
-/
structure liftable_cocone (K : J ⥤ C) (F : C ⥤ D) (c : cocone (K ⋙ F)) :=
(lifted_cocone : cocone K)
(valid_lift : F.map_cocone lifted_cocone ≅ c)

/--
Definition 3.3.1 of [Riehl].
We say that `F` creates limits of `K` if, given any limit cone `c` for `K ⋙ F`
(i.e. below) we can lift it to a cone "above", and further that `F` reflects
limits for `K`.

If `F` reflects isomorphisms, it suffices to show only that the lifted cone is
a limit - see `creates_limit_of_reflects_iso`.
-/
class creates_limit (K : J ⥤ C) (F : C ⥤ D) extends reflects_limit K F :=
(lifts : Π c, is_limit c → liftable_cone K F c)

/--
`F` creates limits of shape `J` if `F` creates the limit of any diagram
`K : J ⥤ C`.
-/
class creates_limits_of_shape (J : Type v) [small_category J] (F : C ⥤ D) :=
(creates_limit : Π {K : J ⥤ C}, creates_limit K F)

/-- `F` creates limits if it creates limits of shape `J` for any small `J`. -/
class creates_limits (F : C ⥤ D) :=
(creates_limits_of_shape : Π {J : Type v} {𝒥 : small_category J},
  by exactI creates_limits_of_shape J F)

/--
Dual of definition 3.3.1 of [Riehl].
We say that `F` creates colimits of `K` if, given any limit cocone `c` for
`K ⋙ F` (i.e. below) we can lift it to a cocone "above", and further that `F`
reflects limits for `K`.

If `F` reflects isomorphisms, it suffices to show only that the lifted cocone is
a limit - see `creates_limit_of_reflects_iso`.
-/
class creates_colimit (K : J ⥤ C) (F : C ⥤ D) extends reflects_colimit K F :=
(lifts : Π c, is_colimit c → liftable_cocone K F c)

/--
`F` creates colimits of shape `J` if `F` creates the colimit of any diagram
`K : J ⥤ C`.
-/
class creates_colimits_of_shape (J : Type v) [small_category J] (F : C ⥤ D) :=
(creates_colimit : Π {K : J ⥤ C}, creates_colimit K F)

/-- `F` creates colimits if it creates colimits of shape `J` for any small `J`. -/
class creates_colimits (F : C ⥤ D) :=
(creates_colimits_of_shape : Π {J : Type v} {𝒥 : small_category J},
  by exactI creates_colimits_of_shape J F)

attribute [instance, priority 100] -- see Note [lower instance priority]
  creates_limits_of_shape.creates_limit creates_limits.creates_limits_of_shape
  creates_colimits_of_shape.creates_colimit creates_colimits.creates_colimits_of_shape

/- Interface to the `creates_limit` class. -/

/-- `lift_limit t` is the cone for `K` given by lifting the limit `t` for `K ⋙ F`. -/
def lift_limit {K : J ⥤ C} {F : C ⥤ D} [creates_limit K F] {c : cone (K ⋙ F)} (t : is_limit c) :
  cone K :=
(creates_limit.lifts c t).lifted_cone

/-- The lifted cone has an image isomorphic to the original cone. -/
def lifted_limit_maps_to_original {K : J ⥤ C} {F : C ⥤ D}
  [creates_limit K F] {c : cone (K ⋙ F)} (t : is_limit c) :
  F.map_cone (lift_limit t) ≅ c :=
(creates_limit.lifts c t).valid_lift

/-- The lifted cone is a limit. -/
def lifted_limit_is_limit {K : J ⥤ C} {F : C ⥤ D}
  [creates_limit K F] {c : cone (K ⋙ F)} (t : is_limit c) :
  is_limit (lift_limit t) :=
reflects_limit.reflects (is_limit.of_iso_limit t (lifted_limit_maps_to_original t).symm)

/-- If `F` creates the limit of `K` and `K ⋙ F` has a limit, then `K` has a limit. -/
lemma has_limit_of_created (K : J ⥤ C) (F : C ⥤ D)
  [has_limit (K ⋙ F)] [creates_limit K F] : has_limit K :=
has_limit.mk { cone := lift_limit (limit.is_limit (K ⋙ F)),
  is_limit := lifted_limit_is_limit _ }

/--
If `F` creates limits of shape `J`, and `D` has limits of shape `J`, then
`C` has limits of shape `J`.
-/
lemma has_limits_of_shape_of_has_limits_of_shape_creates_limits_of_shape (F : C ⥤ D)
  [has_limits_of_shape J D] [creates_limits_of_shape J F] : has_limits_of_shape J C :=
⟨λ G, has_limit_of_created G F⟩

/-- If `F` creates limits, and `D` has all limits, then `C` has all limits. -/
lemma has_limits_of_has_limits_creates_limits (F : C ⥤ D) [has_limits D] [creates_limits F] :
  has_limits C :=
⟨λ J I, by exactI has_limits_of_shape_of_has_limits_of_shape_creates_limits_of_shape F⟩

/- Interface to the `creates_colimit` class. -/

/-- `lift_colimit t` is the cocone for `K` given by lifting the colimit `t` for `K ⋙ F`. -/
def lift_colimit {K : J ⥤ C} {F : C ⥤ D} [creates_colimit K F] {c : cocone (K ⋙ F)}
  (t : is_colimit c) :
  cocone K :=
(creates_colimit.lifts c t).lifted_cocone

/-- The lifted cocone has an image isomorphic to the original cocone. -/
def lifted_colimit_maps_to_original {K : J ⥤ C} {F : C ⥤ D}
  [creates_colimit K F] {c : cocone (K ⋙ F)} (t : is_colimit c) :
  F.map_cocone (lift_colimit t) ≅ c :=
(creates_colimit.lifts c t).valid_lift

/-- The lifted cocone is a colimit. -/
def lifted_colimit_is_colimit {K : J ⥤ C} {F : C ⥤ D}
  [creates_colimit K F] {c : cocone (K ⋙ F)} (t : is_colimit c) :
  is_colimit (lift_colimit t) :=
reflects_colimit.reflects (is_colimit.of_iso_colimit t (lifted_colimit_maps_to_original t).symm)

/-- If `F` creates the limit of `K` and `K ⋙ F` has a limit, then `K` has a limit. -/
lemma has_colimit_of_created (K : J ⥤ C) (F : C ⥤ D)
  [has_colimit (K ⋙ F)] [creates_colimit K F] : has_colimit K :=
has_colimit.mk { cocone := lift_colimit (colimit.is_colimit (K ⋙ F)),
  is_colimit := lifted_colimit_is_colimit _ }

/--
If `F` creates colimits of shape `J`, and `D` has colimits of shape `J`, then
`C` has colimits of shape `J`.
-/
lemma has_colimits_of_shape_of_has_colimits_of_shape_creates_colimits_of_shape (F : C ⥤ D)
  [has_colimits_of_shape J D] [creates_colimits_of_shape J F] : has_colimits_of_shape J C :=
⟨λ G, has_colimit_of_created G F⟩

/-- If `F` creates colimits, and `D` has all colimits, then `C` has all colimits. -/
lemma has_colimits_of_has_colimits_creates_colimits (F : C ⥤ D) [has_colimits D]
  [creates_colimits F] : has_colimits C :=
⟨λ J I, by exactI has_colimits_of_shape_of_has_colimits_of_shape_creates_colimits_of_shape F⟩

/--
A helper to show a functor creates limits. In particular, if we can show
that for any limit cone `c` for `K ⋙ F`, there is a lift of it which is
a limit and `F` reflects isomorphisms, then `F` creates limits.
Usually, `F` creating limits says that _any_ lift of `c` is a limit, but
here we only need to show that our particular lift of `c` is a limit.
-/
structure lifts_to_limit (K : J ⥤ C) (F : C ⥤ D) (c : cone (K ⋙ F)) (t : is_limit c)
  extends liftable_cone K F c :=
(makes_limit : is_limit lifted_cone)

/--
A helper to show a functor creates colimits. In particular, if we can show
that for any limit cocone `c` for `K ⋙ F`, there is a lift of it which is
a limit and `F` reflects isomorphisms, then `F` creates colimits.
Usually, `F` creating colimits says that _any_ lift of `c` is a colimit, but
here we only need to show that our particular lift of `c` is a colimit.
-/
structure lifts_to_colimit (K : J ⥤ C) (F : C ⥤ D) (c : cocone (K ⋙ F)) (t : is_colimit c)
  extends liftable_cocone K F c :=
(makes_colimit : is_colimit lifted_cocone)

/--
If `F` reflects isomorphisms and we can lift any limit cone to a limit cone,
then `F` creates limits.
In particular here we don't need to assume that F reflects limits.
-/
def creates_limit_of_reflects_iso {K : J ⥤ C} {F : C ⥤ D} [reflects_isomorphisms F]
  (h : Π c t, lifts_to_limit K F c t) :
  creates_limit K F :=
{ lifts := λ c t, (h c t).to_liftable_cone,
  to_reflects_limit :=
  { reflects := λ (d : cone K) (hd : is_limit (F.map_cone d)),
    begin
      let d' : cone K := (h (F.map_cone d) hd).to_liftable_cone.lifted_cone,
      let i : F.map_cone d' ≅ F.map_cone d := (h (F.map_cone d) hd).to_liftable_cone.valid_lift,
      let hd' : is_limit d' := (h (F.map_cone d) hd).makes_limit,
      let f : d ⟶ d' := hd'.lift_cone_morphism d,
      have : (cones.functoriality K F).map f = i.inv := (hd.of_iso_limit i.symm).uniq_cone_morphism,
      haveI : is_iso ((cones.functoriality K F).map f) := (by { rw this, apply_instance }),
      haveI : is_iso f := is_iso_of_reflects_iso f (cones.functoriality K F),
      exact is_limit.of_iso_limit hd' (as_iso f).symm,
    end } }

/--
When `F` is fully faithful, and `has_limit (K ⋙ F)`, to show that `F` creates the limit for `K`
it suffices to exhibit a lift of the chosen limit cone for `K ⋙ F`.
-/
-- Notice however that even if the isomorphism is `iso.refl _`,
-- this construction will insert additional identity morphisms in the cone maps,
-- so the constructed limits may not be ideal, definitionally.
def creates_limit_of_fully_faithful_of_lift {K : J ⥤ C} {F : C ⥤ D}
  [full F] [faithful F] [has_limit (K ⋙ F)]
  (c : cone K) (i : F.map_cone c ≅ limit.cone (K ⋙ F)) : creates_limit K F :=
creates_limit_of_reflects_iso (λ c' t,
{ lifted_cone := c,
  valid_lift := i.trans (is_limit.unique_up_to_iso (limit.is_limit _) t),
  makes_limit := is_limit.of_faithful F (is_limit.of_iso_limit (limit.is_limit _) i.symm)
    (λ s, F.preimage _) (λ s, F.image_preimage _) })

/--
When `F` is fully faithful, and `has_limit (K ⋙ F)`, to show that `F` creates the limit for `K`
it suffices to show that the chosen limit point is in the essential image of `F`.
-/
-- Notice however that even if the isomorphism is `iso.refl _`,
-- this construction will insert additional identity morphisms in the cone maps,
-- so the constructed limits may not be ideal, definitionally.
def creates_limit_of_fully_faithful_of_iso {K : J ⥤ C} {F : C ⥤ D}
  [full F] [faithful F] [has_limit (K ⋙ F)]
  (X : C) (i : F.obj X ≅ limit (K ⋙ F)) : creates_limit K F :=
creates_limit_of_fully_faithful_of_lift
({ X := X,
  π :=
  { app := λ j, F.preimage (i.hom ≫ limit.π (K ⋙ F) j),
    naturality' := λ Y Z f, F.map_injective (by { dsimp, simp, erw limit.w (K ⋙ F), }) }} : cone K)
(by { fapply cones.ext, exact i, tidy, })

/-- `F` preserves the limit of `K` if it creates the limit and `K ⋙ F` has the limit. -/
@[priority 100] -- see Note [lower instance priority]
instance preserves_limit_of_creates_limit_and_has_limit (K : J ⥤ C) (F : C ⥤ D)
  [creates_limit K F] [has_limit (K ⋙ F)] :
  preserves_limit K F :=
{ preserves := λ c t, is_limit.of_iso_limit (limit.is_limit _)
    ((lifted_limit_maps_to_original (limit.is_limit _)).symm ≪≫
      ((cones.functoriality K F).map_iso
        ((lifted_limit_is_limit (limit.is_limit _)).unique_up_to_iso t))) }

/-- `F` preserves the limit of shape `J` if it creates these limits and `D` has them. -/
@[priority 100] -- see Note [lower instance priority]
instance preserves_limit_of_shape_of_creates_limits_of_shape_and_has_limits_of_shape (F : C ⥤ D)
  [creates_limits_of_shape J F] [has_limits_of_shape J D] :
  preserves_limits_of_shape J F :=
{ preserves_limit := λ K, category_theory.preserves_limit_of_creates_limit_and_has_limit K F }

/-- `F` preserves limits if it creates limits and `D` has limits. -/
@[priority 100] -- see Note [lower instance priority]
instance preserves_limits_of_creates_limits_and_has_limits (F : C ⥤ D) [creates_limits F]
  [has_limits D] :
  preserves_limits F :=
{ preserves_limits_of_shape := λ J 𝒥,
  by exactI
    category_theory.preserves_limit_of_shape_of_creates_limits_of_shape_and_has_limits_of_shape F }

/--
If `F` reflects isomorphisms and we can lift any colimit cocone to a colimit cocone,
then `F` creates colimits.
In particular here we don't need to assume that F reflects colimits.
-/
def creates_colimit_of_reflects_iso {K : J ⥤ C} {F : C ⥤ D} [reflects_isomorphisms F]
  (h : Π c t, lifts_to_colimit K F c t) :
  creates_colimit K F :=
{ lifts := λ c t, (h c t).to_liftable_cocone,
  to_reflects_colimit :=
  { reflects := λ (d : cocone K) (hd : is_colimit (F.map_cocone d)),
    begin
      let d' : cocone K := (h (F.map_cocone d) hd).to_liftable_cocone.lifted_cocone,
      let i : F.map_cocone d' ≅ F.map_cocone d :=
        (h (F.map_cocone d) hd).to_liftable_cocone.valid_lift,
      let hd' : is_colimit d' := (h (F.map_cocone d) hd).makes_colimit,
      let f : d' ⟶ d := hd'.desc_cocone_morphism d,
      have : (cocones.functoriality K F).map f = i.hom :=
        (hd.of_iso_colimit i.symm).uniq_cocone_morphism,
      haveI : is_iso ((cocones.functoriality K F).map f) := (by { rw this, apply_instance }),
      haveI := is_iso_of_reflects_iso f (cocones.functoriality K F),
      exact is_colimit.of_iso_colimit hd' (as_iso f),
    end } }

/-- `F` preserves the colimit of `K` if it creates the colimit and `K ⋙ F` has the colimit. -/
@[priority 100] -- see Note [lower instance priority]
instance preserves_colimit_of_creates_colimit_and_has_colimit (K : J ⥤ C) (F : C ⥤ D)
  [creates_colimit K F] [has_colimit (K ⋙ F)] :
  preserves_colimit K F :=
{ preserves := λ c t, is_colimit.of_iso_colimit (colimit.is_colimit _)
    ((lifted_colimit_maps_to_original (colimit.is_colimit _)).symm ≪≫
      ((cocones.functoriality K F).map_iso
        ((lifted_colimit_is_colimit (colimit.is_colimit _)).unique_up_to_iso t))) }

/-- `F` preserves the colimit of shape `J` if it creates these colimits and `D` has them. -/
@[priority 100] -- see Note [lower instance priority]
instance preserves_colimit_of_shape_of_creates_colimits_of_shape_and_has_colimits_of_shape
  (F : C ⥤ D) [creates_colimits_of_shape J F] [has_colimits_of_shape J D] :
  preserves_colimits_of_shape J F :=
{ preserves_colimit := λ K,
    category_theory.preserves_colimit_of_creates_colimit_and_has_colimit K F }

/-- `F` preserves limits if it creates limits and `D` has limits. -/
@[priority 100] -- see Note [lower instance priority]
instance preserves_colimits_of_creates_colimits_and_has_colimits (F : C ⥤ D) [creates_colimits F]
  [has_colimits D] :
  preserves_colimits F :=
{ preserves_colimits_of_shape := λ J 𝒥,
  by exactI category_theory.preserves_colimit_of_shape_of_creates_colimits_of_shape_and_has_colimits_of_shape F }

/-- If `F` creates the limit of `K` and `F ≅ G`, then `G` creates the limit of `K`. -/
def creates_limit_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [creates_limit K F] :
  creates_limit K G :=
{ lifts := λ c t,
  { lifted_cone :=
      lift_limit ((is_limit.postcompose_inv_equiv (iso_whisker_left K h : _) c).symm t),
    valid_lift :=
    begin
      refine (is_limit.map_cone_equiv h _).unique_up_to_iso t,
      apply is_limit.of_iso_limit _ ((lifted_limit_maps_to_original _).symm),
      apply (is_limit.postcompose_inv_equiv _ _).symm t,
    end },
  to_reflects_limit := reflects_limit_of_nat_iso _ h }

/-- If `F` creates limits of shape `J` and `F ≅ G`, then `G` creates limits of shape `J`. -/
def creates_limits_of_shape_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [creates_limits_of_shape J F] :
  creates_limits_of_shape J G :=
{ creates_limit := λ K, creates_limit_of_nat_iso h }

/-- If `F` creates limits and `F ≅ G`, then `G` creates limits. -/
def creates_limits_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [creates_limits F] :
  creates_limits G :=
{ creates_limits_of_shape := λ J 𝒥₁, by exactI creates_limits_of_shape_of_nat_iso h }

/-- If `F` creates the colimit of `K` and `F ≅ G`, then `G` creates the colimit of `K`. -/
def creates_colimit_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [creates_colimit K F] :
  creates_colimit K G :=
{ lifts := λ c t,
  { lifted_cocone :=
      lift_colimit ((is_colimit.precompose_hom_equiv (iso_whisker_left K h : _) c).symm t),
    valid_lift :=
    begin
      refine (is_colimit.map_cocone_equiv h _).unique_up_to_iso t,
      apply is_colimit.of_iso_colimit _ ((lifted_colimit_maps_to_original _).symm),
      apply (is_colimit.precompose_hom_equiv _ _).symm t,
    end },
  to_reflects_colimit := reflects_colimit_of_nat_iso _ h }

/-- If `F` creates colimits of shape `J` and `F ≅ G`, then `G` creates colimits of shape `J`. -/
def creates_colimits_of_shape_of_nat_iso {F G : C ⥤ D} (h : F ≅ G)
  [creates_colimits_of_shape J F] : creates_colimits_of_shape J G :=
{ creates_colimit := λ K, creates_colimit_of_nat_iso h }

/-- If `F` creates colimits and `F ≅ G`, then `G` creates colimits. -/
def creates_colimits_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [creates_colimits F] :
  creates_colimits G :=
{ creates_colimits_of_shape := λ J 𝒥₁, by exactI creates_colimits_of_shape_of_nat_iso h }

-- For the inhabited linter later.
/-- If F creates the limit of K, any cone lifts to a limit. -/
def lifts_to_limit_of_creates (K : J ⥤ C) (F : C ⥤ D)
  [creates_limit K F] (c : cone (K ⋙ F)) (t : is_limit c) :
  lifts_to_limit K F c t :=
{ lifted_cone := lift_limit t,
  valid_lift := lifted_limit_maps_to_original t,
  makes_limit := lifted_limit_is_limit t }

-- For the inhabited linter later.
/-- If F creates the colimit of K, any cocone lifts to a colimit. -/
def lifts_to_colimit_of_creates (K : J ⥤ C) (F : C ⥤ D)
  [creates_colimit K F] (c : cocone (K ⋙ F)) (t : is_colimit c) :
  lifts_to_colimit K F c t :=
{ lifted_cocone := lift_colimit t,
  valid_lift := lifted_colimit_maps_to_original t,
  makes_colimit := lifted_colimit_is_colimit t }

/-- Any cone lifts through the identity functor. -/
def id_lifts_cone (c : cone (K ⋙ 𝟭 C)) : liftable_cone K (𝟭 C) c :=
{ lifted_cone :=
  { X := c.X,
    π := c.π ≫ K.right_unitor.hom },
  valid_lift := cones.ext (iso.refl _) (by tidy) }

/-- The identity functor creates all limits. -/
instance id_creates_limits : creates_limits (𝟭 C) :=
{ creates_limits_of_shape := λ J 𝒥, by exactI
  { creates_limit := λ F, { lifts := λ c t, id_lifts_cone c } } }

/-- Any cocone lifts through the identity functor. -/
def id_lifts_cocone (c : cocone (K ⋙ 𝟭 C)) : liftable_cocone K (𝟭 C) c :=
{ lifted_cocone :=
  { X := c.X,
    ι := K.right_unitor.inv ≫ c.ι },
  valid_lift := cocones.ext (iso.refl _) (by tidy) }

/-- The identity functor creates all colimits. -/
instance id_creates_colimits : creates_colimits (𝟭 C) :=
{ creates_colimits_of_shape := λ J 𝒥, by exactI
  { creates_colimit := λ F, { lifts := λ c t, id_lifts_cocone c } } }

/-- Satisfy the inhabited linter -/
instance inhabited_liftable_cone (c : cone (K ⋙ 𝟭 C)) : inhabited (liftable_cone K (𝟭 C) c) :=
⟨id_lifts_cone c⟩
instance inhabited_liftable_cocone (c : cocone (K ⋙ 𝟭 C)) : inhabited (liftable_cocone K (𝟭 C) c) :=
⟨id_lifts_cocone c⟩

/-- Satisfy the inhabited linter -/
instance inhabited_lifts_to_limit (K : J ⥤ C) (F : C ⥤ D)
  [creates_limit K F] (c : cone (K ⋙ F)) (t : is_limit c) :
  inhabited (lifts_to_limit _ _ _ t) :=
⟨lifts_to_limit_of_creates K F c t⟩
instance inhabited_lifts_to_colimit (K : J ⥤ C) (F : C ⥤ D)
  [creates_colimit K F] (c : cocone (K ⋙ F)) (t : is_colimit c) :
  inhabited (lifts_to_colimit _ _ _ t) :=
⟨lifts_to_colimit_of_creates K F c t⟩

section comp

variables {E : Type u₃} [ℰ : category.{v} E]
variables (F : C ⥤ D) (G : D ⥤ E)

instance comp_creates_limit [creates_limit K F] [creates_limit (K ⋙ F) G] :
  creates_limit K (F ⋙ G) :=
{ lifts := λ c t,
  { lifted_cone := lift_limit (lifted_limit_is_limit t),
    valid_lift := (cones.functoriality (K ⋙ F) G).map_iso
      (lifted_limit_maps_to_original (lifted_limit_is_limit t)) ≪≫
      (lifted_limit_maps_to_original t) } }

instance comp_creates_limits_of_shape [creates_limits_of_shape J F] [creates_limits_of_shape J G] :
  creates_limits_of_shape J (F ⋙ G) :=
{ creates_limit := infer_instance }

instance comp_creates_limits [creates_limits F] [creates_limits G] :
  creates_limits (F ⋙ G) :=
{ creates_limits_of_shape := infer_instance }

instance comp_creates_colimit [creates_colimit K F] [creates_colimit (K ⋙ F) G] :
  creates_colimit K (F ⋙ G) :=
{ lifts := λ c t,
  { lifted_cocone := lift_colimit (lifted_colimit_is_colimit t),
    valid_lift := (cocones.functoriality (K ⋙ F) G).map_iso
      (lifted_colimit_maps_to_original (lifted_colimit_is_colimit t)) ≪≫
      (lifted_colimit_maps_to_original t) } }

instance comp_creates_colimits_of_shape
  [creates_colimits_of_shape J F] [creates_colimits_of_shape J G] :
  creates_colimits_of_shape J (F ⋙ G) :=
{ creates_colimit := infer_instance }

instance comp_creates_colimits [creates_colimits F] [creates_colimits G] :
  creates_colimits (F ⋙ G) :=
{ creates_colimits_of_shape := infer_instance }

end comp

end creates

end category_theory


/-

From adam's serie:

https://www.youtube.com/watch?v=SkruxPmN0kk
https://www.youtube.com/watch?v=nvHatVfiLPU

-/

constant U : Type

-- sumo axioms

constants SetOrClass Set Class Object Entity : U

constant ins : U → U → Prop
constant subclass : U → U → Prop

constant element : U → U → Prop
constant birthplace : U → U → Prop
constant subProcess : U → U → Prop

-- problem axioms

constants John Mary Stanley Jimmy Jane Human SetJohnMaryStan SetJohnMaryJimmy OshkoshHuman
          OshkoshWisconsin FeymanLecture Lecture Thanking FeymansThankingBohr GeographicLocation : U

axiom john_human    : ins John Human
axiom mary_human    : ins Mary Human
axiom stanley_human : ins Stanley Human
axiom jimmy_human   : ins Jimmy Human
axiom jane_ohuman   : ins Jane OshkoshHuman

axiom oshkoshwis_geo : ins OshkoshWisconsin GeographicLocation

axiom john_mary_stan : ins SetJohnMaryStan Set
axiom john_el_jms    : element John SetJohnMaryStan
axiom mary_el_jms    : element Mary SetJohnMaryStan
axiom stanley_el_jms : element Stanley SetJohnMaryStan

axiom john_mary_jimmy : ins SetJohnMaryJimmy Set
axiom john_el_jmj     : element John SetJohnMaryJimmy
axiom mary_el_jmj     : element Mary SetJohnMaryJimmy
axiom jimmy_jmj       : element Jimmy SetJohnMaryJimmy

-- https://en.wikipedia.org/wiki/Closed-world_assumption
axiom jimmy_not_jms   : ¬ element Jimmy SetJohnMaryStan

axiom oshkoshHuman_cl : subclass OshkoshHuman Human
axiom oshkoshHuman_ax : ∀ x : U, ins x OshkoshHuman → birthplace x OshkoshWisconsin

lemma sets_not_equal : ¬ SetJohnMaryStan = SetJohnMaryJimmy :=
begin
 intro a,
 have h₁, from jimmy_not_jms,
 rw a at h₁,
 exact (h₁ jimmy_jmj),
end

lemma birthplace_jane : birthplace Jane OshkoshWisconsin :=
begin
 have h₁, from oshkoshHuman_ax Jane,
 exact (h₁ jane_ohuman),
end


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

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

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

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

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

universes u v w

open category_theory
open category_theory.limits

variables {R : Type u} [ring R]

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

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

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

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

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

open prequotient

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end Module.colimits


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.terminal
import category_theory.limits.shapes.pullbacks
import category_theory.limits.shapes.binary_products

/-!
# Constructing binary product from pullbacks and terminal object.

If a category has pullbacks and a terminal object, then it has binary products.

TODO: provide the dual result.
-/

universes v u

open category_theory category_theory.category category_theory.limits

/-- Any category with pullbacks and terminal object has binary products. -/
-- This is not an instance, as it is not always how one wants to construct binary products!
lemma has_binary_products_of_terminal_and_pullbacks
  (C : Type u) [𝒞 : category.{v} C] [has_terminal C] [has_pullbacks C] :
  has_binary_products C :=
{ has_limit := λ F, has_limit.mk
  { cone :=
    { X := pullback (terminal.from (F.obj walking_pair.left))
                    (terminal.from (F.obj walking_pair.right)),
      π := discrete.nat_trans (λ x, walking_pair.cases_on x pullback.fst pullback.snd)},
    is_limit :=
    { lift := λ c, pullback.lift ((c.π).app walking_pair.left)
                                  ((c.π).app walking_pair.right)
                                  (subsingleton.elim _ _),
      fac' := λ s c, walking_pair.cases_on c (limit.lift_π _ _) (limit.lift_π _ _),
      uniq' := λ s m J,
                begin
                  rw [←J, ←J],
                  ext;
                  rw limit.lift_π;
                  refl
                end } } }


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import probability.probability_mass_function.basic

/-!
# Misc Lemmas That Ideally Should Port to Mathlib
-/

variables {α β γ : Type*}

open_locale ennreal

lemma finset.count_to_list [decidable_eq α] (s : finset α) (a : α) :
  s.to_list.count a = ite (a ∈ s) 1 0 :=
by simp only [list.count_eq_of_nodup s.nodup_to_list, finset.mem_to_list]

lemma vector.cons_eq_cons {n : ℕ} (x y : α) (xs ys : vector α n) :
  x ::ᵥ xs = y ::ᵥ ys ↔ x = y ∧ xs = ys :=
⟨λ h, have x = y ∧ xs.to_list = ys.to_list, by simpa only [vector.to_list_cons]
  using congr_arg vector.to_list h, ⟨this.1, vector.eq _ _ this.2⟩, λ h, h.1 ▸ h.2 ▸ rfl⟩

section list_stuff

variables (x : α) (n : ℕ)

section mem

/-- Only `x` is a member of `list.repeat x n` (unless `n = 0` which has no members). -/
@[simp] lemma list.mem_repeat_iff (y : α) : y ∈ (list.repeat x n) ↔ 0 < n ∧ y = x :=
begin
  induction n with n hn,
  { rw [lt_self_iff_false, false_and, list.repeat, list.mem_nil_iff] },
  { simp [hn] }
end

lemma list.not_mem_repeat_zero (y : α) : y ∉ (list.repeat x 0) :=
by simp_rw [list.mem_repeat_iff, lt_self_iff_false, false_and, not_false_iff]

lemma list.mem_repeat_succ_iff (y : α) : y ∈ (list.repeat x n.succ) ↔ y = x :=
by simp_rw [list.mem_repeat_iff, nat.zero_lt_succ, true_and]

lemma list.eq_of_mem_repeat {x y : α} {n : ℕ} (hy : y ∈ (list.repeat x n)) : y = x :=
((list.mem_repeat_iff x n y).1 hy).2

lemma list.pos_of_mem_repeat {x y : α} {n : ℕ} (hy : y ∈ (list.repeat x n)) : 0 < n :=
((list.mem_repeat_iff x n y).1 hy).1

end mem

section nth

@[simp] lemma list.nth_le_repeat (m : ℕ) (hm : m < (list.repeat x n).length) :
  (list.repeat x n).nth_le m hm = x :=
list.eq_of_mem_repeat (list.mem_iff_nth_le.2 ⟨m, hm, rfl⟩)

@[simp] lemma list.nth_repeat (m : ℕ) : (list.repeat x n).nth m = if m < n then some x else none :=
begin
  split_ifs with h,
  { exact list.nth_eq_some.2 ⟨(list.length_repeat x n).symm ▸ h, list.nth_le_repeat x n m _⟩ },
  { exact list.nth_eq_none_iff.2 (le_of_not_lt $ (list.length_repeat x n).symm ▸ h) }
end

lemma list.nth_repeat_eq_none_iff (m : ℕ) : (list.repeat x n).nth m = none ↔ n ≤ m :=
by rw [list.nth_eq_none_iff, list.length_repeat]

lemma list.nth_repeat_eq_some_iff (m : ℕ) (y : α) :
  (list.repeat x n).nth m = some y ↔ m < n ∧ x = y :=
by simp only [ite_eq_iff, list.nth_repeat, and_false, or_false]

end nth

section find

lemma list.find_repeat (p : α → Prop) [decidable_pred p] :
  (list.repeat x n).find p = if 0 < n ∧ p x then some x else none :=
begin
  split_ifs with hx,
  { cases n with n,
    { exact ((lt_self_iff_false 0).1 hx.1).elim },
    { exact list.find_cons_of_pos _ hx.2 } },
  { refine list.find_eq_none.2 (λ y hy, (list.eq_of_mem_repeat hy).symm ▸ _),
    simpa only [not_and_distrib, list.pos_of_mem_repeat hy, not_true, false_or] using hx }
end

@[simp] lemma list.find_repeat_eq_none_iff  (p : α → Prop) [decidable_pred p] :
  (list.repeat x n).find p = none ↔ n = 0 ∨ ¬ p x :=
by simp_rw [list.find_repeat, ite_eq_right_iff, imp_false, not_and_distrib, not_lt, le_zero_iff]

@[simp] lemma list.find_repeat_eq_some_iff (p : α → Prop) [decidable_pred p] (y : α) :
  (list.repeat x n).find p = some y ↔ 0 < n ∧ p x ∧ y = x :=
by simp_rw [list.find_repeat, ite_eq_iff, and_assoc, eq_comm, and_false, or_false]

end find

@[simp] lemma list.all₂_repeat_iff (p : α → Prop) : (list.repeat x n).all₂ p ↔ n = 0 ∨ p x :=
by simp [list.all₂_iff_forall, lt_iff_not_le, or_iff_not_imp_left]

@[simp] lemma list.all_repeat (p : α → bool) :
  (list.repeat x n).all p = if n = 0 then tt else p x :=
begin
  induction n with n hn,
  { refl },
  { simp only [nat.succ_ne_zero, if_false, list.repeat, list.all, list.foldr_cons],
    by_cases hn' : n = 0,
    { rw [hn', list.repeat, list.foldr, band_tt] },
    { exact (congr_arg ((&&) (p x)) (hn.trans (if_neg hn'))).trans (band_self (p x)) } }
end

@[simp] lemma list.reverse_repeat : (list.repeat x n).reverse = list.repeat x n :=
begin
  refine list.ext_le (list.length_reverse _) (λ m hm hm', _),
  rw [list.nth_le_repeat, list.nth_le_reverse' _ m, list.nth_le_repeat],
  exact lt_of_le_of_lt tsub_le_self (tsub_lt_self (lt_of_le_of_lt zero_le' hm') zero_lt_one),
end

@[simp] lemma list.rotate_repeat (m : ℕ) : (list.repeat x n).rotate m = list.repeat x n :=
begin
  refine list.ext_le (list.length_rotate _ _) (λ m hm hm', _),
  rw [list.nth_le_repeat, list.nth_le_rotate, list.nth_le_repeat],
end

@[simp] lemma list.concat_self_repeat : (list.repeat x n).concat x = list.repeat x (n + 1) :=
by rw [list.concat_eq_reverse_cons, list.reverse_repeat, ← list.repeat, list.reverse_repeat]

@[simp] lemma list.map_repeat (f : α → β) : (list.repeat x n).map f = list.repeat (f x) n :=
begin
  induction n with n hn,
  { exact rfl },
  { exact (list.map_cons f x _).trans (congr_arg ((::) (f x)) hn) }
end

@[simp] lemma list.filter_repeat (p : α → Prop) [decidable_pred p] :
  (list.repeat x n).filter p = if p x then list.repeat x n else [] :=
begin
  induction n with n hn,
  { exact (if_t_t _ []).symm },
  { split_ifs with hp; simp [hp, hn] }
end

lemma list.repeat_add (m : ℕ) :
  list.repeat x (n + m) = list.repeat x n ++ list.repeat x m :=
begin
  induction n with n hn,
  { rw [list.repeat, zero_add, list.nil_append] },
  { rw [nat.succ_add, list.repeat, hn, ← list.cons_append, list.repeat] }
end

lemma list.repeat_sub (m : ℕ) :
  list.repeat x (n - m) = (list.repeat x n).drop m :=
begin
  refine list.ext_le _ (λ m hm hm', _),
  { simp_rw [list.length_drop, list.length_repeat] },
  { simp_rw [list.nth_le_drop', list.nth_le_repeat] }
end

end list_stuff


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

import algebraic_geometry.ringed_space
import algebraic_geometry.stalks
import data.equiv.transfer_instance

/-!
# The category of locally ringed spaces

We define (bundled) locally ringed spaces (as `SheafedSpace CommRing` along with the fact that the
stalks are local rings), and morphisms between these (morphisms in `SheafedSpace` with
`is_local_ring_hom` on the stalk maps).
-/

universes v u

open category_theory
open Top
open topological_space
open opposite
open category_theory.category category_theory.functor

namespace algebraic_geometry

/-- A `LocallyRingedSpace` is a topological space equipped with a sheaf of commutative rings
such that all the stalks are local rings.

A morphism of locally ringed spaces is a morphism of ringed spaces
such that the morphisms induced on stalks are local ring homomorphisms. -/
@[nolint has_inhabited_instance]
structure LocallyRingedSpace extends SheafedSpace CommRing :=
(local_ring : ∀ x, local_ring (presheaf.stalk x))

attribute [instance] LocallyRingedSpace.local_ring

namespace LocallyRingedSpace

variables (X : LocallyRingedSpace)

/--
An alias for `to_SheafedSpace`, where the result type is a `RingedSpace`.
This allows us to use dot-notation for the `RingedSpace` namespace.
 -/
def to_RingedSpace : RingedSpace := X.to_SheafedSpace

/-- The underlying topological space of a locally ringed space. -/
def to_Top : Top := X.1.carrier

instance : has_coe_to_sort LocallyRingedSpace (Type u) :=
⟨λ X : LocallyRingedSpace, (X.to_Top : Type u)⟩

-- PROJECT: how about a typeclass "has_structure_sheaf" to mediate the 𝒪 notation, rather
-- than defining it over and over for PresheafedSpace, LRS, Scheme, etc.

/-- The structure sheaf of a locally ringed space. -/
def 𝒪 : sheaf CommRing X.to_Top := X.to_SheafedSpace.sheaf

/-- A morphism of locally ringed spaces is a morphism of ringed spaces
 such that the morphims induced on stalks are local ring homomorphisms. -/
def hom (X Y : LocallyRingedSpace) : Type* :=
{ f : X.to_SheafedSpace ⟶ Y.to_SheafedSpace //
    ∀ x, is_local_ring_hom (PresheafedSpace.stalk_map f x) }

instance : quiver LocallyRingedSpace := ⟨hom⟩

@[ext] lemma hom_ext {X Y : LocallyRingedSpace} (f g : hom X Y) (w : f.1 = g.1) : f = g :=
subtype.eq w

/--
The stalk of a locally ringed space, just as a `CommRing`.
-/
-- TODO perhaps we should make a bundled `LocalRing` and return one here?
-- TODO define `sheaf.stalk` so we can write `X.𝒪.stalk` here?
noncomputable
def stalk (X : LocallyRingedSpace) (x : X) : CommRing := X.presheaf.stalk x

/--
A morphism of locally ringed spaces `f : X ⟶ Y` induces
a local ring homomorphism from `Y.stalk (f x)` to `X.stalk x` for any `x : X`.
-/
noncomputable
def stalk_map {X Y : LocallyRingedSpace} (f : X ⟶ Y) (x : X) :
  Y.stalk (f.1.1 x) ⟶ X.stalk x :=
PresheafedSpace.stalk_map f.1 x

instance {X Y : LocallyRingedSpace} (f : X ⟶ Y) (x : X) :
  is_local_ring_hom (stalk_map f x) := f.2 x

instance {X Y : LocallyRingedSpace} (f : X ⟶ Y) (x : X) :
   is_local_ring_hom (PresheafedSpace.stalk_map f.1 x) := f.2 x

/-- The identity morphism on a locally ringed space. -/
@[simps]
def id (X : LocallyRingedSpace) : hom X X :=
⟨𝟙 _, λ x, by { erw PresheafedSpace.stalk_map.id, apply is_local_ring_hom_id, }⟩

instance (X : LocallyRingedSpace) : inhabited (hom X X) := ⟨id X⟩

/-- Composition of morphisms of locally ringed spaces. -/
@[simps]
def comp {X Y Z : LocallyRingedSpace} (f : hom X Y) (g : hom Y Z) : hom X Z :=
⟨f.val ≫ g.val, λ x,
begin
  erw PresheafedSpace.stalk_map.comp,
  exact @is_local_ring_hom_comp _ _ _ _ _ _ _ _ (f.2 _) (g.2 _),
end⟩

/-- The category of locally ringed spaces. -/
instance : category LocallyRingedSpace :=
{ hom := hom,
  id := id,
  comp := λ X Y Z f g, comp f g,
  comp_id' := by { intros, ext1, simp, },
  id_comp' := by { intros, ext1, simp, },
  assoc' := by { intros, ext1, simp, }, }.

/-- The forgetful functor from `LocallyRingedSpace` to `SheafedSpace CommRing`. -/
def forget_to_SheafedSpace : LocallyRingedSpace ⥤ SheafedSpace CommRing :=
{ obj := λ X, X.to_SheafedSpace,
  map := λ X Y f, f.1, }

instance : faithful forget_to_SheafedSpace := {}

/--
Given two locally ringed spaces `X` and `Y`, an isomorphism between `X` and `Y` as _sheafed_
spaces can be lifted to a morphism `X ⟶ Y` as locally ringed spaces.

See also `iso_of_SheafedSpace_iso`.
-/
@[simps]
def hom_of_SheafedSpace_hom_of_is_iso {X Y : LocallyRingedSpace}
  (f : X.to_SheafedSpace ⟶ Y.to_SheafedSpace) [is_iso f] : X ⟶ Y :=
subtype.mk f $ λ x,
-- Here we need to see that the stalk maps are really local ring homomorphisms.
-- This can be solved by type class inference, because stalk maps of isomorphisms are isomorphisms
-- and isomorphisms are local ring homomorphisms.
show is_local_ring_hom (PresheafedSpace.stalk_map
  (SheafedSpace.forget_to_PresheafedSpace.map f) x),
by apply_instance

/--
Given two locally ringed spaces `X` and `Y`, an isomorphism between `X` and `Y` as _sheafed_
spaces can be lifted to an isomorphism `X ⟶ Y` as locally ringed spaces.

This is related to the property that the functor `forget_to_SheafedSpace` reflects isomorphisms.
In fact, it is slightly stronger as we do not require `f` to come from a morphism between
_locally_ ringed spaces.
-/
def iso_of_SheafedSpace_iso {X Y : LocallyRingedSpace}
  (f : X.to_SheafedSpace ≅ Y.to_SheafedSpace) : X ≅ Y :=
{ hom := hom_of_SheafedSpace_hom_of_is_iso f.hom,
  inv := hom_of_SheafedSpace_hom_of_is_iso f.inv,
  hom_inv_id' := hom_ext _ _ f.hom_inv_id,
  inv_hom_id' := hom_ext _ _ f.inv_hom_id }

instance : reflects_isomorphisms forget_to_SheafedSpace :=
{ reflects := λ X Y f i,
  { out := by exactI
    ⟨hom_of_SheafedSpace_hom_of_is_iso (category_theory.inv (forget_to_SheafedSpace.map f)),
      hom_ext _ _ (is_iso.hom_inv_id _), hom_ext _ _ (is_iso.inv_hom_id _)⟩ } }

/--
The restriction of a locally ringed space along an open embedding.
-/
@[simps]
def restrict {U : Top} (X : LocallyRingedSpace) {f : U ⟶ X.to_Top}
  (h : open_embedding f) : LocallyRingedSpace :=
{ local_ring :=
  begin
    intro x,
    dsimp at *,
    -- We show that the stalk of the restriction is isomorphic to the original stalk,
    apply @ring_equiv.local_ring _ _ _ (X.local_ring (f x)),
    exact (X.to_PresheafedSpace.restrict_stalk_iso h x).symm.CommRing_iso_to_ring_equiv,
  end,
  .. X.to_SheafedSpace.restrict h }

/--
The restriction of a locally ringed space `X` to the top subspace is isomorphic to `X` itself.
-/
def restrict_top_iso (X : LocallyRingedSpace) :
  X.restrict (opens.open_embedding ⊤) ≅ X :=
@iso_of_SheafedSpace_iso (X.restrict (opens.open_embedding ⊤)) X
  X.to_SheafedSpace.restrict_top_iso

/--
The global sections, notated Gamma.
-/
def Γ : LocallyRingedSpaceᵒᵖ ⥤ CommRing :=
forget_to_SheafedSpace.op ⋙ SheafedSpace.Γ

lemma Γ_def : Γ = forget_to_SheafedSpace.op ⋙ SheafedSpace.Γ := rfl

@[simp] lemma Γ_obj (X : LocallyRingedSpaceᵒᵖ) : Γ.obj X = (unop X).presheaf.obj (op ⊤) := rfl

lemma Γ_obj_op (X : LocallyRingedSpace) : Γ.obj (op X) = X.presheaf.obj (op ⊤) := rfl

@[simp] lemma Γ_map {X Y : LocallyRingedSpaceᵒᵖ} (f : X ⟶ Y) :
  Γ.map f = f.unop.1.c.app (op ⊤) := rfl

lemma Γ_map_op {X Y : LocallyRingedSpace} (f : X ⟶ Y) :
  Γ.map f.op = f.1.c.app (op ⊤) := rfl

lemma preimage_basic_open {X Y : LocallyRingedSpace} (f : X ⟶ Y) {U : opens Y}
  (s : Y.presheaf.obj (op U)) :
  (opens.map f.1.base).obj (Y.to_RingedSpace.basic_open s) =
    @RingedSpace.basic_open X.to_RingedSpace ((opens.map f.1.base).obj U) (f.1.c.app _ s) :=
begin
  ext,
  split,
  { rintros ⟨⟨y, hyU⟩, (hy : is_unit _), (rfl : y = _)⟩,
    erw RingedSpace.mem_basic_open _ _ ⟨x, show x ∈ (opens.map f.1.base).obj U, from hyU⟩,
    rw ← PresheafedSpace.stalk_map_germ_apply,
    exact (PresheafedSpace.stalk_map f.1 _).is_unit_map hy },
  { rintros ⟨y, (hy : is_unit _), rfl⟩,
    erw RingedSpace.mem_basic_open _ _ ⟨f.1.base y.1, y.2⟩,
    rw ← PresheafedSpace.stalk_map_germ_apply at hy,
    exact (is_unit_map_iff (PresheafedSpace.stalk_map f.1 _) _).mp hy }
end

end LocallyRingedSpace

end algebraic_geometry


class Vec (X : Type) extends Add X, Inhabited X

class Vec' (X : Type) extends Vec X

def differential {X Y : Type} [Vec X] [Vec Y] (f : X → Y) (x dx : X) : Y := f dx

@[simp]
theorem differential_of_linear {X Y : Type} [Vec X] [Vec Y] (f : X → Y) (x dx : X)
        : differential f x dx = f dx := by simp[differential]

example {X Y : Type} [Vec X] [Vec Y] (f : X → Y) (x dx : X)
        : differential f x dx = f dx := by simp

instance : Vec Nat := ⟨⟩
instance : Vec' Nat := ⟨⟩

set_option trace.Meta.Tactic.simp true
example {Y : Type} [Vec Y] (f : Nat → Y) (x dx : Nat)
        : @differential _ _ Vec'.toVec _ f x dx = f dx :=
  by simp