inductive HList {α : Type v} (β : α → Type u) : List α → Type (max u v)
  | nil  : HList β []
  | cons : β i → HList β is → HList β (i::is)

infix:67 " :: " => HList.cons

inductive Member : α → List α → Type _
  | head : Member a (a::as)
  | tail : Member a bs → Member a (b::bs)

def HList.get : HList β is → Member i is → β i
  | a::as, .head => a
  | a::as, .tail h => as.get h

inductive Ty where
  | nat
  | fn : Ty → Ty → Ty

abbrev Ty.denote : Ty → Type
  | nat    => Nat
  | fn a b => a.denote → b.denote

inductive Term : List Ty → Ty → Type
  | var   : Member ty ctx → Term ctx ty
  | const : Nat → Term ctx .nat
  | plus  : Term ctx .nat → Term ctx .nat → Term ctx .nat
  | app   : Term ctx (.fn dom ran) → Term ctx dom → Term ctx ran
  | lam   : Term (dom :: ctx) ran → Term ctx (.fn dom ran)
  | «let» : Term ctx ty₁ → Term (ty₁ :: ctx) ty₂ → Term ctx ty₂

@[simp] def Term.denote : Term ctx ty → HList Ty.denote ctx → ty.denote
  | var h,     env => env.get h
  | const n,   _   => n
  | plus a b,  env => a.denote env + b.denote env
  | app f a,   env => f.denote env (a.denote env)
  | lam b,     env => fun x => b.denote (x :: env)
  | «let» a b, env => b.denote (a.denote env :: env)

@[simp] def Term.constFold : Term ctx ty → Term ctx ty
  | const n   => const n
  | var h     => var h
  | app f a   => app f.constFold a.constFold
  | lam b     => lam b.constFold
  | «let» a b => «let» a.constFold b.constFold
  | plus a b  =>
    match a.constFold, b.constFold with
    | const n, const m => const (n+m)
    | a',      b'      => plus a' b'

theorem Term.constFold_sound (e : Term ctx ty) : e.constFold.denote env = e.denote env := by
  induction e with simp [*]
  | plus a b iha ihb =>
    split
    next he₁ he₂ => simp [← iha, ← ihb, he₁, he₂]
    next => simp [iha, ihb]


/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn
-/
prelude
import init.data.list.basic init.function init.meta init.data.nat.lemmas
import init.meta.interactive init.meta.smt.rsimp

universes u v w w₁ w₂
variables {α : Type u} {β : Type v} {γ : Type w}

namespace list
open nat

/- append -/

@[simp] lemma nil_append (s : list α) : [] ++ s = s :=
rfl

@[simp] lemma cons_append (x : α) (s t : list α) : (x::s) ++ t = x::(s ++ t) :=
rfl

@[simp] lemma append_nil (t : list α) : t ++ [] = t :=
by induction t; simp [*]

@[simp] lemma append_assoc (s t u : list α) : s ++ t ++ u = s ++ (t ++ u) :=
by induction s; simp [*]

/- length -/

lemma length_cons (a : α) (l : list α) : length (a :: l) = length l + 1 :=
rfl

@[simp] lemma length_append (s t : list α) : length (s ++ t) = length s + length t :=
begin
  induction s,
  { show length t = 0 + length t, by rw nat.zero_add },
  { simp [*, nat.add_comm, nat.add_left_comm] },
end

@[simp] lemma length_repeat (a : α) (n : ℕ) : length (repeat a n) = n :=
by induction n; simp [*]; refl

@[simp] lemma length_tail (l : list α) : length (tail l) = length l - 1 :=
by cases l; refl

-- TODO(Leo): cleanup proof after arith dec proc
@[simp] lemma length_drop : ∀ (i : ℕ) (l : list α), length (drop i l) = length l - i
| 0 l         := rfl
| (succ i) [] := eq.symm (nat.zero_sub (succ i))
| (succ i) (x::l) := calc
  length (drop (succ i) (x::l))
          = length l - i             : length_drop i l
      ... = succ (length l) - succ i : (nat.succ_sub_succ_eq_sub (length l) i).symm

/- map -/

lemma map_cons (f : α → β) (a l) : map f (a::l) = f a :: map f l :=
rfl

@[simp] lemma map_append (f : α → β) : ∀ l₁ l₂, map f (l₁ ++ l₂) = (map f l₁) ++ (map f l₂) :=
by intro l₁; induction l₁; intros; simp [*]

lemma map_singleton (f : α → β) (a : α) : map f [a] = [f a] :=
rfl

@[simp] lemma map_id (l : list α) : map id l = l :=
by induction l; simp [*]

@[simp] lemma map_map (g : β → γ) (f : α → β) (l : list α) : map g (map f l) = map (g ∘ f) l :=
by induction l; simp [*]

@[simp] lemma length_map (f : α → β) (l : list α) : length (map f l) = length l :=
by induction l; simp [*]

/- bind -/

@[simp] lemma nil_bind (f : α → list β) : list.bind [] f = [] :=
by simp [join, list.bind]

@[simp] lemma cons_bind (x xs) (f : α → list β) : list.bind (x :: xs) f = f x ++ list.bind xs f :=
by simp [join, list.bind]

@[simp] lemma append_bind (xs ys) (f : α → list β) :
  list.bind (xs ++ ys) f = list.bind xs f ++ list.bind ys f :=
by induction xs; [refl, simp [*, cons_bind]]

/- mem -/

lemma mem_nil_iff (a : α) : a ∈ ([] : list α) ↔ false :=
iff.rfl

@[simp] lemma not_mem_nil (a : α) : a ∉ ([] : list α) :=
not_false

lemma mem_cons_self (a : α) (l : list α) : a ∈ a :: l :=
or.inl rfl

@[simp] lemma mem_cons_iff (a y : α) (l : list α) : a ∈ y :: l ↔ (a = y ∨ a ∈ l) :=
iff.rfl

@[rsimp] lemma mem_cons_eq (a y : α) (l : list α) : (a ∈ y :: l) = (a = y ∨ a ∈ l) :=
rfl

lemma mem_cons_of_mem (y : α) {a : α} {l : list α} : a ∈ l → a ∈ y :: l :=
assume H, or.inr H

lemma eq_or_mem_of_mem_cons {a y : α} {l : list α} : a ∈ y::l → a = y ∨ a ∈ l :=
assume h, h

@[simp] lemma mem_append {a : α} {s t : list α} : a ∈ s ++ t ↔ a ∈ s ∨ a ∈ t :=
by induction s; simp [*, or_assoc]

@[rsimp] lemma mem_append_eq (a : α) (s t : list α) : (a ∈ s ++ t) = (a ∈ s ∨ a ∈ t) :=
propext mem_append

lemma mem_append_left {a : α} {l₁ : list α} (l₂ : list α) (h : a ∈ l₁) : a ∈ l₁ ++ l₂ :=
mem_append.2 (or.inl h)

lemma mem_append_right {a : α} (l₁ : list α) {l₂ : list α} (h : a ∈ l₂) : a ∈ l₁ ++ l₂ :=
mem_append.2 (or.inr h)

lemma not_bex_nil (p : α → Prop) : ¬ (∃ x ∈ @nil α, p x) :=
λ⟨x, hx, px⟩, hx

lemma ball_nil (p : α → Prop) : ∀ x ∈ @nil α, p x :=
λx, false.elim

lemma bex_cons (p : α → Prop) (a : α) (l : list α) :
  (∃ x ∈ (a :: l), p x) ↔ (p a ∨ ∃ x ∈ l, p x) :=
⟨λ⟨x, h, px⟩, by {
  simp at h, cases h with h h, {cases h, exact or.inl px}, {exact or.inr ⟨x, h, px⟩}},
λo, o.elim (λpa, ⟨a, mem_cons_self _ _, pa⟩)
  (λ⟨x, h, px⟩, ⟨x, mem_cons_of_mem _ h, px⟩)⟩

lemma ball_cons (p : α → Prop) (a : α) (l : list α) :
  (∀ x ∈ (a :: l), p x) ↔ (p a ∧ ∀ x ∈ l, p x) :=
⟨λal, ⟨al a (mem_cons_self _ _), λx h, al x (mem_cons_of_mem _ h)⟩,
 λ⟨pa, al⟩ x o, o.elim (λe, e.symm ▸ pa) (al x)⟩

/- list subset -/

protected def subset (l₁ l₂ : list α) := ∀ ⦃a : α⦄, a ∈ l₁ → a ∈ l₂

instance : has_subset (list α) := ⟨list.subset⟩

@[simp] lemma nil_subset (l : list α) : [] ⊆ l :=
λ b i, false.elim (iff.mp (mem_nil_iff b) i)

@[refl, simp] lemma subset.refl (l : list α) : l ⊆ l :=
λ b i, i

@[trans] lemma subset.trans {l₁ l₂ l₃ : list α} (h₁ : l₁ ⊆ l₂) (h₂ : l₂ ⊆ l₃) : l₁ ⊆ l₃ :=
λ b i, h₂ (h₁ i)

@[simp] lemma subset_cons (a : α) (l : list α) : l ⊆ a::l :=
λ b i, or.inr i

lemma subset_of_cons_subset {a : α} {l₁ l₂ : list α} : a::l₁ ⊆ l₂ → l₁ ⊆ l₂ :=
λ s b i, s (mem_cons_of_mem _ i)

lemma cons_subset_cons {l₁ l₂ : list α} (a : α) (s : l₁ ⊆ l₂) : (a::l₁) ⊆ (a::l₂) :=
λ b hin, or.elim (eq_or_mem_of_mem_cons hin)
  (λ e : b = a,  or.inl e)
  (λ i : b ∈ l₁, or.inr (s i))

@[simp] lemma subset_append_left (l₁ l₂ : list α) : l₁ ⊆ l₁++l₂ :=
λ b, mem_append_left _

@[simp] lemma subset_append_right (l₁ l₂ : list α) : l₂ ⊆ l₁++l₂ :=
λ b, mem_append_right _

lemma subset_cons_of_subset (a : α) {l₁ l₂ : list α} : l₁ ⊆ l₂ → l₁ ⊆ (a::l₂) :=
λ (s : l₁ ⊆ l₂) (a : α) (i : a ∈ l₁), or.inr (s i)

theorem eq_nil_of_length_eq_zero {l : list α} : length l = 0 → l = [] :=
by {induction l; intros, refl, contradiction}

theorem ne_nil_of_length_eq_succ {l : list α} : ∀ {n : nat}, length l = succ n → l ≠ [] :=
by induction l; intros; contradiction

@[simp] theorem length_map₂ (f : α → β → γ) (l₁) : ∀ l₂, length (map₂ f l₁ l₂) = min (length l₁) (length l₂) :=
by { induction l₁; intro l₂; cases l₂; simp [*, add_one, min_succ_succ, nat.zero_min, nat.min_zero] }

@[simp] theorem length_take : ∀ (i : ℕ) (l : list α), length (take i l) = min i (length l)
| 0        l      := by simp [nat.zero_min]
| (succ n) []     := by simp [nat.min_zero]
| (succ n) (a::l) := by simp [*, nat.min_succ_succ, add_one]

theorem length_take_le (n) (l : list α) : length (take n l) ≤ n :=
by simp [min_le_left]

theorem length_remove_nth : ∀ (l : list α) (i : ℕ), i < length l → length (remove_nth l i) = length l - 1
| []      _     h := rfl
| (x::xs) 0     h := by simp [remove_nth]
| (x::xs) (i+1) h := have i < length xs, from lt_of_succ_lt_succ h,
  by dsimp [remove_nth]; rw [length_remove_nth xs i this, nat.sub_add_cancel (lt_of_le_of_lt (nat.zero_le _) this)]; refl

@[simp] lemma partition_eq_filter_filter (p : α → Prop) [decidable_pred p] : ∀ (l : list α), partition p l = (filter p l, filter (not ∘ p) l)
| []     := rfl
| (a::l) := by { by_cases pa : p a; simp [partition, filter, pa, partition_eq_filter_filter l] }

/- sublists -/

inductive sublist : list α → list α → Prop
| slnil : sublist [] []
| cons (l₁ l₂ a) : sublist l₁ l₂ → sublist l₁ (a::l₂)
| cons2 (l₁ l₂ a) : sublist l₁ l₂ → sublist (a::l₁) (a::l₂)

infix ` <+ `:50 := sublist

lemma length_le_of_sublist : ∀ {l₁ l₂ : list α}, l₁ <+ l₂ → length l₁ ≤ length l₂
| _ _ sublist.slnil             := le_refl 0
| _ _ (sublist.cons  l₁ l₂ a s) := le_succ_of_le (length_le_of_sublist s)
| _ _ (sublist.cons2 l₁ l₂ a s) := succ_le_succ (length_le_of_sublist s)

/- filter -/
@[simp] theorem filter_nil (p : α → Prop) [h : decidable_pred p] : filter p [] = [] := rfl

@[simp] theorem filter_cons_of_pos {p : α → Prop} [h : decidable_pred p] {a : α} :
   ∀ l, p a → filter p (a::l) = a :: filter p l :=
λ l pa, if_pos pa

@[simp] theorem filter_cons_of_neg {p : α → Prop} [h : decidable_pred p] {a : α} :
  ∀ l, ¬ p a → filter p (a::l) = filter p l :=
λ l pa, if_neg pa

@[simp] theorem filter_append {p : α → Prop} [h : decidable_pred p] :
  ∀ (l₁ l₂ : list α), filter p (l₁++l₂) = filter p l₁ ++ filter p l₂
| []      l₂ := rfl
| (a::l₁) l₂ := by by_cases pa : p a; simp [pa, filter_append]

@[simp] theorem filter_sublist {p : α → Prop} [h : decidable_pred p] : Π (l : list α), filter p l <+ l
| []     := sublist.slnil
| (a::l) := if pa : p a
  then by simp [pa]; apply sublist.cons2; apply filter_sublist l
  else by simp [pa]; apply sublist.cons; apply filter_sublist l

/- map_accumr -/
section map_accumr
variables {φ : Type w₁} {σ : Type w₂}

-- This runs a function over a list returning the intermediate results and a
-- a final result.
def map_accumr (f : α → σ → σ × β) : list α → σ → (σ × list β)
| [] c := (c, [])
| (y::yr) c :=
  let r := map_accumr yr c in
  let z := f y r.1 in
  (z.1, z.2 :: r.2)

@[simp] theorem length_map_accumr
: ∀ (f : α → σ → σ × β) (x : list α) (s : σ),
  length (map_accumr f x s).2 = length x
| f (a::x) s := congr_arg succ (length_map_accumr f x s)
| f [] s := rfl

end map_accumr

section map_accumr₂
variables {φ : Type w₁} {σ : Type w₂}
-- This runs a function over two lists returning the intermediate results and a
-- a final result.
def map_accumr₂ (f : α → β → σ → σ × φ)
  : list α → list β → σ → σ × list φ
| [] _ c := (c,[])
| _ [] c := (c,[])
| (x::xr) (y::yr) c :=
  let r := map_accumr₂ xr yr c in
  let q := f x y r.1 in
  (q.1, q.2 :: r.2)

@[simp] theorem length_map_accumr₂ : ∀ (f : α → β → σ → σ × φ) x y c,
  length (map_accumr₂ f x y c).2 = min (length x) (length y)
| f (a::x) (b::y) c := calc
    succ (length (map_accumr₂ f x y c).2)
              = succ (min (length x) (length y))
              : congr_arg succ (length_map_accumr₂ f x y c)
          ... = min (succ (length x)) (succ (length y))
              : eq.symm (min_succ_succ (length x) (length y))
| f (a::x) [] c := rfl
| f [] (b::y) c := rfl
| f [] []     c := rfl
end map_accumr₂

end list


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

! This file was ported from Lean 3 source module category_theory.whiskering
! 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.CategoryTheory.Isomorphism
import Mathbin.CategoryTheory.Functor.Category
import Mathbin.CategoryTheory.Functor.FullyFaithful

/-!
# Whiskering

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

Given a functor `F  : C ⥤ D` and functors `G H : D ⥤ E` and a natural transformation `α : G ⟶ H`,
we can construct a new natural transformation `F ⋙ G ⟶ F ⋙ H`,
called `whisker_left F α`. This is the same as the horizontal composition of `𝟙 F` with `α`.

This operation is functorial in `F`, and we package this as `whiskering_left`. Here
`(whiskering_left.obj F).obj G` is `F ⋙ G`, and
`(whiskering_left.obj F).map α` is `whisker_left F α`.
(That is, we might have alternatively named this as the "left composition functor".)

We also provide analogues for composition on the right, and for these operations on isomorphisms.

At the end of the file, we provide the left and right unitors, and the associator,
for functor composition.
(In fact functor composition is definitionally associative, but very often relying on this causes
extremely slow elaboration, so it is better to insert it explicitly.)
We also show these natural isomorphisms satisfy the triangle and pentagon identities.
-/

namespace CategoryTheory

universe u₁ v₁ u₂ v₂ u₃ v₃ u₄ v₄

section

variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D] {E : Type u₃}
  [Category.{v₃} E]

#print CategoryTheory.whiskerLeft /-
/-- If `α : G ⟶ H` then
`whisker_left F α : (F ⋙ G) ⟶ (F ⋙ H)` has components `α.app (F.obj X)`.
-/
@[simps]
def whiskerLeft (F : C ⥤ D) {G H : D ⥤ E} (α : G ⟶ H) : F ⋙ G ⟶ F ⋙ H
    where
  app X := α.app (F.obj X)
  naturality' X Y f := by rw [functor.comp_map, functor.comp_map, α.naturality]
#align category_theory.whisker_left CategoryTheory.whiskerLeft
-/

#print CategoryTheory.whiskerRight /-
/-- If `α : G ⟶ H` then
`whisker_right α F : (G ⋙ F) ⟶ (G ⋙ F)` has components `F.map (α.app X)`.
-/
@[simps]
def whiskerRight {G H : C ⥤ D} (α : G ⟶ H) (F : D ⥤ E) : G ⋙ F ⟶ H ⋙ F
    where
  app X := F.map (α.app X)
  naturality' X Y f := by
    rw [functor.comp_map, functor.comp_map, ← F.map_comp, ← F.map_comp, α.naturality]
#align category_theory.whisker_right CategoryTheory.whiskerRight
-/

variable (C D E)

#print CategoryTheory.whiskeringLeft /-
/-- Left-composition gives a functor `(C ⥤ D) ⥤ ((D ⥤ E) ⥤ (C ⥤ E))`.

`(whiskering_left.obj F).obj G` is `F ⋙ G`, and
`(whiskering_left.obj F).map α` is `whisker_left F α`.
-/
@[simps]
def whiskeringLeft : (C ⥤ D) ⥤ (D ⥤ E) ⥤ C ⥤ E
    where
  obj F :=
    { obj := fun G => F ⋙ G
      map := fun G H α => whiskerLeft F α }
  map F G τ :=
    { app := fun H =>
        { app := fun c => H.map (τ.app c)
          naturality' := fun X Y f => by dsimp; rw [← H.map_comp, ← H.map_comp, ← τ.naturality] }
      naturality' := fun X Y f => by ext; dsimp; rw [f.naturality] }
#align category_theory.whiskering_left CategoryTheory.whiskeringLeft
-/

#print CategoryTheory.whiskeringRight /-
/-- Right-composition gives a functor `(D ⥤ E) ⥤ ((C ⥤ D) ⥤ (C ⥤ E))`.

`(whiskering_right.obj H).obj F` is `F ⋙ H`, and
`(whiskering_right.obj H).map α` is `whisker_right α H`.
-/
@[simps]
def whiskeringRight : (D ⥤ E) ⥤ (C ⥤ D) ⥤ C ⥤ E
    where
  obj H :=
    { obj := fun F => F ⋙ H
      map := fun _ _ α => whiskerRight α H }
  map G H τ :=
    { app := fun F =>
        { app := fun c => τ.app (F.obj c)
          naturality' := fun X Y f => by dsimp; rw [τ.naturality] }
      naturality' := fun X Y f => by ext; dsimp; rw [← nat_trans.naturality] }
#align category_theory.whiskering_right CategoryTheory.whiskeringRight
-/

variable {C} {D} {E}

/- warning: category_theory.faithful_whiskering_right_obj -> CategoryTheory.faithful_whiskeringRight_obj is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] {D : Type.{u3}} [_inst_2 : CategoryTheory.Category.{u4, u3} D] {E : Type.{u5}} [_inst_3 : CategoryTheory.Category.{u6, u5} E] {F : CategoryTheory.Functor.{u4, u6, u3, u5} D _inst_2 E _inst_3} [_inst_4 : CategoryTheory.Faithful.{u4, u6, u3, u5} D _inst_2 E _inst_3 F], CategoryTheory.Faithful.{max u1 u4, max u1 u6, max u2 u4 u1 u3, max u2 u6 u1 u5} (CategoryTheory.Functor.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.{u2, u6, u1, u5} C _inst_1 E _inst_3) (CategoryTheory.Functor.category.{u2, u6, u1, u5} C _inst_1 E _inst_3) (CategoryTheory.Functor.obj.{max u3 u6, max (max u2 u4 u1 u3) u1 u6, max u4 u6 u3 u5, max (max u1 u4) (max u1 u6) (max u2 u4 u1 u3) u2 u6 u1 u5} (CategoryTheory.Functor.{u4, u6, u3, u5} D _inst_2 E _inst_3) (CategoryTheory.Functor.category.{u4, u6, u3, u5} D _inst_2 E _inst_3) (CategoryTheory.Functor.{max u1 u4, max u1 u6, max u2 u4 u1 u3, max u2 u6 u1 u5} (CategoryTheory.Functor.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.{u2, u6, u1, u5} C _inst_1 E _inst_3) (CategoryTheory.Functor.category.{u2, u6, u1, u5} C _inst_1 E _inst_3)) (CategoryTheory.Functor.category.{max u1 u4, max u1 u6, max u2 u4 u1 u3, max u2 u6 u1 u5} (CategoryTheory.Functor.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.{u2, u6, u1, u5} C _inst_1 E _inst_3) (CategoryTheory.Functor.category.{u2, u6, u1, u5} C _inst_1 E _inst_3)) (CategoryTheory.whiskeringRight.{u1, u2, u3, u4, u5, u6} C _inst_1 D _inst_2 E _inst_3) F)
but is expected to have type
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] {D : Type.{u3}} [_inst_2 : CategoryTheory.Category.{u4, u3} D] {E : Type.{u5}} [_inst_3 : CategoryTheory.Category.{u6, u5} E] {F : CategoryTheory.Functor.{u4, u6, u3, u5} D _inst_2 E _inst_3} [_inst_4 : CategoryTheory.Faithful.{u4, u6, u3, u5} D _inst_2 E _inst_3 F], CategoryTheory.Faithful.{max u1 u4, max u1 u6, max (max (max u1 u3) u2) u4, max (max (max u1 u5) u2) u6} (CategoryTheory.Functor.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.{u2, u6, u1, u5} C _inst_1 E _inst_3) (CategoryTheory.Functor.category.{u2, u6, u1, u5} C _inst_1 E _inst_3) (Prefunctor.obj.{max (succ u3) (succ u6), max (max (max (max (succ u1) (succ u3)) (succ u2)) (succ u4)) (succ u6), max (max (max u3 u5) u4) u6, max (max (max (max (max u1 u3) u5) u2) u4) u6} (CategoryTheory.Functor.{u4, u6, u3, u5} D _inst_2 E _inst_3) (CategoryTheory.CategoryStruct.toQuiver.{max u3 u6, max (max (max u3 u5) u4) u6} (CategoryTheory.Functor.{u4, u6, u3, u5} D _inst_2 E _inst_3) (CategoryTheory.Category.toCategoryStruct.{max u3 u6, max (max (max u3 u5) u4) u6} (CategoryTheory.Functor.{u4, u6, u3, u5} D _inst_2 E _inst_3) (CategoryTheory.Functor.category.{u4, u6, u3, u5} D _inst_2 E _inst_3))) (CategoryTheory.Functor.{max u1 u4, max u1 u6, max (max (max u3 u1) u4) u2, max (max (max u5 u1) u6) u2} (CategoryTheory.Functor.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.{u2, u6, u1, u5} C _inst_1 E _inst_3) (CategoryTheory.Functor.category.{u2, u6, u1, u5} C _inst_1 E _inst_3)) (CategoryTheory.CategoryStruct.toQuiver.{max (max (max (max u1 u3) u2) u4) u6, max (max (max (max (max u1 u3) u5) u2) u4) u6} (CategoryTheory.Functor.{max u1 u4, max u1 u6, max (max (max u3 u1) u4) u2, max (max (max u5 u1) u6) u2} (CategoryTheory.Functor.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.{u2, u6, u1, u5} C _inst_1 E _inst_3) (CategoryTheory.Functor.category.{u2, u6, u1, u5} C _inst_1 E _inst_3)) (CategoryTheory.Category.toCategoryStruct.{max (max (max (max u1 u3) u2) u4) u6, max (max (max (max (max u1 u3) u5) u2) u4) u6} (CategoryTheory.Functor.{max u1 u4, max u1 u6, max (max (max u3 u1) u4) u2, max (max (max u5 u1) u6) u2} (CategoryTheory.Functor.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.{u2, u6, u1, u5} C _inst_1 E _inst_3) (CategoryTheory.Functor.category.{u2, u6, u1, u5} C _inst_1 E _inst_3)) (CategoryTheory.Functor.category.{max u1 u4, max u1 u6, max (max (max u1 u3) u2) u4, max (max (max u1 u5) u2) u6} (CategoryTheory.Functor.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.{u2, u6, u1, u5} C _inst_1 E _inst_3) (CategoryTheory.Functor.category.{u2, u6, u1, u5} C _inst_1 E _inst_3)))) (CategoryTheory.Functor.toPrefunctor.{max u3 u6, max (max (max (max u1 u3) u2) u4) u6, max (max (max u3 u5) u4) u6, max (max (max (max (max u1 u3) u5) u2) u4) u6} (CategoryTheory.Functor.{u4, u6, u3, u5} D _inst_2 E _inst_3) (CategoryTheory.Functor.category.{u4, u6, u3, u5} D _inst_2 E _inst_3) (CategoryTheory.Functor.{max u1 u4, max u1 u6, max (max (max u3 u1) u4) u2, max (max (max u5 u1) u6) u2} (CategoryTheory.Functor.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.{u2, u6, u1, u5} C _inst_1 E _inst_3) (CategoryTheory.Functor.category.{u2, u6, u1, u5} C _inst_1 E _inst_3)) (CategoryTheory.Functor.category.{max u1 u4, max u1 u6, max (max (max u1 u3) u2) u4, max (max (max u1 u5) u2) u6} (CategoryTheory.Functor.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u2, u4, u1, u3} C _inst_1 D _inst_2) (CategoryTheory.Functor.{u2, u6, u1, u5} C _inst_1 E _inst_3) (CategoryTheory.Functor.category.{u2, u6, u1, u5} C _inst_1 E _inst_3)) (CategoryTheory.whiskeringRight.{u1, u2, u3, u4, u5, u6} C _inst_1 D _inst_2 E _inst_3)) F)
Case conversion may be inaccurate. Consider using '#align category_theory.faithful_whiskering_right_obj CategoryTheory.faithful_whiskeringRight_objₓ'. -/
instance faithful_whiskeringRight_obj {F : D ⥤ E} [Faithful F] :
    Faithful ((whiskeringRight C D E).obj F)
    where map_injective' G H α β hαβ :=
    NatTrans.ext _ _ <|
      funext fun X => Functor.map_injective _ <| congr_fun (congr_arg NatTrans.app hαβ) X
#align category_theory.faithful_whiskering_right_obj CategoryTheory.faithful_whiskeringRight_obj

#print CategoryTheory.whiskerLeft_id /-
@[simp]
theorem whiskerLeft_id (F : C ⥤ D) {G : D ⥤ E} :
    whiskerLeft F (NatTrans.id G) = NatTrans.id (F.comp G) :=
  rfl
#align category_theory.whisker_left_id CategoryTheory.whiskerLeft_id
-/

#print CategoryTheory.whiskerLeft_id' /-
@[simp]
theorem whiskerLeft_id' (F : C ⥤ D) {G : D ⥤ E} : whiskerLeft F (𝟙 G) = 𝟙 (F.comp G) :=
  rfl
#align category_theory.whisker_left_id' CategoryTheory.whiskerLeft_id'
-/

#print CategoryTheory.whiskerRight_id /-
@[simp]
theorem whiskerRight_id {G : C ⥤ D} (F : D ⥤ E) :
    whiskerRight (NatTrans.id G) F = NatTrans.id (G.comp F) :=
  ((whiskeringRight C D E).obj F).map_id _
#align category_theory.whisker_right_id CategoryTheory.whiskerRight_id
-/

#print CategoryTheory.whiskerRight_id' /-
@[simp]
theorem whiskerRight_id' {G : C ⥤ D} (F : D ⥤ E) : whiskerRight (𝟙 G) F = 𝟙 (G.comp F) :=
  ((whiskeringRight C D E).obj F).map_id _
#align category_theory.whisker_right_id' CategoryTheory.whiskerRight_id'
-/

#print CategoryTheory.whiskerLeft_comp /-
@[simp]
theorem whiskerLeft_comp (F : C ⥤ D) {G H K : D ⥤ E} (α : G ⟶ H) (β : H ⟶ K) :
    whiskerLeft F (α ≫ β) = whiskerLeft F α ≫ whiskerLeft F β :=
  rfl
#align category_theory.whisker_left_comp CategoryTheory.whiskerLeft_comp
-/

#print CategoryTheory.whiskerRight_comp /-
@[simp]
theorem whiskerRight_comp {G H K : C ⥤ D} (α : G ⟶ H) (β : H ⟶ K) (F : D ⥤ E) :
    whiskerRight (α ≫ β) F = whiskerRight α F ≫ whiskerRight β F :=
  ((whiskeringRight C D E).obj F).map_comp α β
#align category_theory.whisker_right_comp CategoryTheory.whiskerRight_comp
-/

#print CategoryTheory.isoWhiskerLeft /-
/-- If `α : G ≅ H` is a natural isomorphism then
`iso_whisker_left F α : (F ⋙ G) ≅ (F ⋙ H)` has components `α.app (F.obj X)`.
-/
def isoWhiskerLeft (F : C ⥤ D) {G H : D ⥤ E} (α : G ≅ H) : F ⋙ G ≅ F ⋙ H :=
  ((whiskeringLeft C D E).obj F).mapIso α
#align category_theory.iso_whisker_left CategoryTheory.isoWhiskerLeft
-/

#print CategoryTheory.isoWhiskerLeft_hom /-
@[simp]
theorem isoWhiskerLeft_hom (F : C ⥤ D) {G H : D ⥤ E} (α : G ≅ H) :
    (isoWhiskerLeft F α).Hom = whiskerLeft F α.Hom :=
  rfl
#align category_theory.iso_whisker_left_hom CategoryTheory.isoWhiskerLeft_hom
-/

#print CategoryTheory.isoWhiskerLeft_inv /-
@[simp]
theorem isoWhiskerLeft_inv (F : C ⥤ D) {G H : D ⥤ E} (α : G ≅ H) :
    (isoWhiskerLeft F α).inv = whiskerLeft F α.inv :=
  rfl
#align category_theory.iso_whisker_left_inv CategoryTheory.isoWhiskerLeft_inv
-/

#print CategoryTheory.isoWhiskerRight /-
/-- If `α : G ≅ H` then
`iso_whisker_right α F : (G ⋙ F) ≅ (H ⋙ F)` has components `F.map_iso (α.app X)`.
-/
def isoWhiskerRight {G H : C ⥤ D} (α : G ≅ H) (F : D ⥤ E) : G ⋙ F ≅ H ⋙ F :=
  ((whiskeringRight C D E).obj F).mapIso α
#align category_theory.iso_whisker_right CategoryTheory.isoWhiskerRight
-/

#print CategoryTheory.isoWhiskerRight_hom /-
@[simp]
theorem isoWhiskerRight_hom {G H : C ⥤ D} (α : G ≅ H) (F : D ⥤ E) :
    (isoWhiskerRight α F).Hom = whiskerRight α.Hom F :=
  rfl
#align category_theory.iso_whisker_right_hom CategoryTheory.isoWhiskerRight_hom
-/

#print CategoryTheory.isoWhiskerRight_inv /-
@[simp]
theorem isoWhiskerRight_inv {G H : C ⥤ D} (α : G ≅ H) (F : D ⥤ E) :
    (isoWhiskerRight α F).inv = whiskerRight α.inv F :=
  rfl
#align category_theory.iso_whisker_right_inv CategoryTheory.isoWhiskerRight_inv
-/

#print CategoryTheory.isIso_whiskerLeft /-
instance isIso_whiskerLeft (F : C ⥤ D) {G H : D ⥤ E} (α : G ⟶ H) [IsIso α] :
    IsIso (whiskerLeft F α) :=
  IsIso.of_iso (isoWhiskerLeft F (asIso α))
#align category_theory.is_iso_whisker_left CategoryTheory.isIso_whiskerLeft
-/

#print CategoryTheory.isIso_whiskerRight /-
instance isIso_whiskerRight {G H : C ⥤ D} (α : G ⟶ H) (F : D ⥤ E) [IsIso α] :
    IsIso (whiskerRight α F) :=
  IsIso.of_iso (isoWhiskerRight (asIso α) F)
#align category_theory.is_iso_whisker_right CategoryTheory.isIso_whiskerRight
-/

variable {B : Type u₄} [Category.{v₄} B]

attribute [local elab_without_expected_type] whisker_left whisker_right

#print CategoryTheory.whiskerLeft_twice /-
@[simp]
theorem whiskerLeft_twice (F : B ⥤ C) (G : C ⥤ D) {H K : D ⥤ E} (α : H ⟶ K) :
    whiskerLeft F (whiskerLeft G α) = whiskerLeft (F ⋙ G) α :=
  rfl
#align category_theory.whisker_left_twice CategoryTheory.whiskerLeft_twice
-/

#print CategoryTheory.whiskerRight_twice /-
@[simp]
theorem whiskerRight_twice {H K : B ⥤ C} (F : C ⥤ D) (G : D ⥤ E) (α : H ⟶ K) :
    whiskerRight (whiskerRight α F) G = whiskerRight α (F ⋙ G) :=
  rfl
#align category_theory.whisker_right_twice CategoryTheory.whiskerRight_twice
-/

#print CategoryTheory.whiskerRight_left /-
theorem whiskerRight_left (F : B ⥤ C) {G H : C ⥤ D} (α : G ⟶ H) (K : D ⥤ E) :
    whiskerRight (whiskerLeft F α) K = whiskerLeft F (whiskerRight α K) :=
  rfl
#align category_theory.whisker_right_left CategoryTheory.whiskerRight_left
-/

end

namespace Functor

universe u₅ v₅

variable {A : Type u₁} [Category.{v₁} A]

variable {B : Type u₂} [Category.{v₂} B]

#print CategoryTheory.Functor.leftUnitor /-
/-- The left unitor, a natural isomorphism `((𝟭 _) ⋙ F) ≅ F`.
-/
@[simps]
def leftUnitor (F : A ⥤ B) : 𝟭 A ⋙ F ≅ F
    where
  Hom := { app := fun X => 𝟙 (F.obj X) }
  inv := { app := fun X => 𝟙 (F.obj X) }
#align category_theory.functor.left_unitor CategoryTheory.Functor.leftUnitor
-/

#print CategoryTheory.Functor.rightUnitor /-
/-- The right unitor, a natural isomorphism `(F ⋙ (𝟭 B)) ≅ F`.
-/
@[simps]
def rightUnitor (F : A ⥤ B) : F ⋙ 𝟭 B ≅ F
    where
  Hom := { app := fun X => 𝟙 (F.obj X) }
  inv := { app := fun X => 𝟙 (F.obj X) }
#align category_theory.functor.right_unitor CategoryTheory.Functor.rightUnitor
-/

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

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

#print CategoryTheory.Functor.associator /-
/-- The associator for functors, a natural isomorphism `((F ⋙ G) ⋙ H) ≅ (F ⋙ (G ⋙ H))`.

(In fact, `iso.refl _` will work here, but it tends to make Lean slow later,
and it's usually best to insert explicit associators.)
-/
@[simps]
def associator (F : A ⥤ B) (G : B ⥤ C) (H : C ⥤ D) : (F ⋙ G) ⋙ H ≅ F ⋙ G ⋙ H
    where
  Hom := { app := fun _ => 𝟙 _ }
  inv := { app := fun _ => 𝟙 _ }
#align category_theory.functor.associator CategoryTheory.Functor.associator
-/

#print CategoryTheory.Functor.assoc /-
@[protected]
theorem assoc (F : A ⥤ B) (G : B ⥤ C) (H : C ⥤ D) : (F ⋙ G) ⋙ H = F ⋙ G ⋙ H :=
  rfl
#align category_theory.functor.assoc CategoryTheory.Functor.assoc
-/

#print CategoryTheory.Functor.triangle /-
theorem triangle (F : A ⥤ B) (G : B ⥤ C) :
    (associator F (𝟭 B) G).Hom ≫ whiskerLeft F (leftUnitor G).Hom =
      whiskerRight (rightUnitor F).Hom G :=
  by
  ext
  dsimp
  simp
#align category_theory.functor.triangle CategoryTheory.Functor.triangle
-/

-- See note [dsimp, simp].
variable {E : Type u₅} [Category.{v₅} E]

variable (F : A ⥤ B) (G : B ⥤ C) (H : C ⥤ D) (K : D ⥤ E)

#print CategoryTheory.Functor.pentagon /-
theorem pentagon :
    whiskerRight (associator F G H).Hom K ≫
        (associator F (G ⋙ H) K).Hom ≫ whiskerLeft F (associator G H K).Hom =
      (associator (F ⋙ G) H K).Hom ≫ (associator F G (H ⋙ K)).Hom :=
  by
  ext
  dsimp
  simp
#align category_theory.functor.pentagon CategoryTheory.Functor.pentagon
-/

end Functor

end CategoryTheory


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import data.polynomial.monic
import algebra.group_ring_action
import algebra.group_action_hom

/-!
# Group action on rings applied to polynomials

This file contains instances and definitions relating `mul_semiring_action` to `polynomial`.
-/

variables (M : Type*) [monoid M]

namespace polynomial

variables (R : Type*) [semiring R]

noncomputable instance [mul_semiring_action M R] : mul_semiring_action M (polynomial R) :=
{ smul := λ m, map $ mul_semiring_action.to_semiring_hom M R m,
  one_smul := λ p, by { ext n, erw coeff_map, exact one_smul M (p.coeff n) },
  mul_smul := λ m n p, by { ext i,
    iterate 3 { rw coeff_map (mul_semiring_action.to_semiring_hom M R _) },
    exact mul_smul m n (p.coeff i) },
  smul_add := λ m p q, map_add (mul_semiring_action.to_semiring_hom M R m),
  smul_zero := λ m, map_zero (mul_semiring_action.to_semiring_hom M R m),
  smul_one := λ m, map_one (mul_semiring_action.to_semiring_hom M R m),
  smul_mul := λ m p q, map_mul (mul_semiring_action.to_semiring_hom M R m), }

noncomputable instance [faithful_mul_semiring_action M R] :
  faithful_mul_semiring_action M (polynomial R) :=
{ eq_of_smul_eq_smul' := λ m₁ m₂ h, eq_of_smul_eq_smul R $ λ s, C_inj.1 $
    calc  C (m₁ • s)
        = m₁ • C s : (map_C $ mul_semiring_action.to_semiring_hom M R m₁).symm
    ... = m₂ • C s : h (C s)
    ... = C (m₂ • s) : map_C _,
  .. polynomial.mul_semiring_action M R }

variables {M R}

variables [mul_semiring_action M R]

@[simp] lemma coeff_smul' (m : M) (p : polynomial R) (n : ℕ) :
  (m • p).coeff n = m • p.coeff n :=
coeff_map _ _

@[simp] lemma smul_C (m : M) (r : R) : m • C r = C (m • r) :=
map_C _

@[simp] lemma smul_X (m : M) : (m • X : polynomial R) = X :=
map_X _

variables (S : Type*) [comm_semiring S] [mul_semiring_action M S]

theorem smul_eval_smul (m : M) (f : polynomial S) (x : S) :
  (m • f).eval (m • x) = m • f.eval x :=
polynomial.induction_on f
  (λ r, by rw [smul_C, eval_C, eval_C])
  (λ f g ihf ihg, by rw [smul_add, eval_add, ihf, ihg, eval_add, smul_add])
  (λ n r ih, by rw [smul_mul', smul_pow, smul_C, smul_X, eval_mul, eval_C, eval_pow, eval_X,
      eval_mul, eval_C, eval_pow, eval_X, smul_mul', smul_pow])

variables (G : Type*) [group G]

theorem eval_smul' [mul_semiring_action G S] (g : G) (f : polynomial S) (x : S) :
  f.eval (g • x) = g • (g⁻¹ • f).eval x :=
by rw [← smul_eval_smul, smul_inv_smul]

theorem smul_eval [mul_semiring_action G S] (g : G) (f : polynomial S) (x : S) :
  (g • f).eval x = g • f.eval (g⁻¹ • x) :=
by rw [← smul_eval_smul, smul_inv_smul]

end polynomial

section comm_ring

variables (G : Type*) [group G] [fintype G]
variables (R : Type*) [comm_ring R] [mul_semiring_action G R]
open mul_action
open_locale classical

/-- the product of `(X - g • x)` over distinct `g • x`. -/
noncomputable def prod_X_sub_smul (x : R) : polynomial R :=
(finset.univ : finset (quotient_group.quotient $ mul_action.stabilizer G x)).prod $
λ g, polynomial.X - polynomial.C (of_quotient_stabilizer G x g)

theorem prod_X_sub_smul.monic (x : R) : (prod_X_sub_smul G R x).monic :=
polynomial.monic_prod_of_monic _ _ $ λ g _, polynomial.monic_X_sub_C _

theorem prod_X_sub_smul.eval (x : R) : (prod_X_sub_smul G R x).eval x = 0 :=
(finset.prod_hom _ (polynomial.eval x)).symm.trans $
  finset.prod_eq_zero (finset.mem_univ $ quotient_group.mk 1) $
  by rw [of_quotient_stabilizer_mk, one_smul, polynomial.eval_sub, polynomial.eval_X,
    polynomial.eval_C, sub_self]

theorem prod_X_sub_smul.smul (x : R) (g : G) :
  g • prod_X_sub_smul G R x = prod_X_sub_smul G R x :=
(smul_prod _ _ _ _ _).trans $ fintype.prod_bijective _ (mul_action.bijective g) _ _
  (λ g', by rw [of_quotient_stabilizer_smul, smul_sub, polynomial.smul_X, polynomial.smul_C])

theorem prod_X_sub_smul.coeff (x : R) (g : G) (n : ℕ) :
  g • (prod_X_sub_smul G R x).coeff n =
  (prod_X_sub_smul G R x).coeff n :=
by rw [← polynomial.coeff_smul', prod_X_sub_smul.smul]

end comm_ring

namespace mul_semiring_action_hom
variables {M}
variables {P : Type*} [comm_semiring P] [mul_semiring_action M P]
variables {Q : Type*} [comm_semiring Q] [mul_semiring_action M Q]
open polynomial

/-- An equivariant map induces an equivariant map on polynomials. -/
protected noncomputable def polynomial (g : P →+*[M] Q) : polynomial P →+*[M] polynomial Q :=
{ to_fun := map g,
  map_smul' := λ m p, polynomial.induction_on p
    (λ b, by rw [smul_C, map_C, coe_fn_coe, g.map_smul, map_C, coe_fn_coe, smul_C])
    (λ p q ihp ihq, by rw [smul_add, polynomial.map_add, ihp, ihq, polynomial.map_add, smul_add])
    (λ n b ih, by rw [smul_mul', smul_C, smul_pow, smul_X, polynomial.map_mul, map_C,
        polynomial.map_pow, map_X, coe_fn_coe, g.map_smul, polynomial.map_mul, map_C,
        polynomial.map_pow, map_X, smul_mul', smul_C, smul_pow, smul_X, coe_fn_coe]),
  map_zero' := polynomial.map_zero g,
  map_add' := λ p q, polynomial.map_add g,
  map_one' := polynomial.map_one g,
  map_mul' := λ p q, polynomial.map_mul g }

@[simp] theorem coe_polynomial (g : P →+*[M] Q) :
  (g.polynomial : polynomial P → polynomial Q) = map g :=
rfl

end mul_semiring_action_hom


/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Anatole Dedecker
-/
import analysis.locally_convex.balanced_core_hull

/-!
# Finite dimensional topological vector spaces over complete fields

Let `𝕜` be a nondiscrete and complete normed field, and `E` a topological vector space (TVS) over
`𝕜` (i.e we have `[add_comm_group E] [module 𝕜 E] [topological_space E] [topological_add_group E]`
and `[has_continuous_smul 𝕜 E]`).

If `E` is finite dimensional and Hausdorff, then all linear maps from `E` to any other TVS are
continuous.

When `E` is a normed space, this gets us the equivalence of norms in finite dimension.

## Main results :

* `linear_map.continuous_iff_is_closed_ker` : a linear form is continuous if and only if its kernel
  is closed.
* `linear_map.continuous_of_finite_dimensional` : a linear map on a finite-dimensional Hausdorff
  space over a complete field is continuous.

## TODO

Generalize more of `analysis/normed_space/finite_dimension` to general TVSs.

## Implementation detail

The main result from which everything follows is the fact that, if `ξ : ι → E` is a finite basis,
then `ξ.equiv_fun : E →ₗ (ι → 𝕜)` is continuous. However, for technical reasons, it is easier to
prove this when `ι` and `E` live ine the same universe. So we start by doing that as a private
lemma, then we deduce `linear_map.continuous_of_finite_dimensional` from it, and then the general
result follows as `continuous_equiv_fun_basis`.

-/

universes u v w x

noncomputable theory

open set finite_dimensional topological_space filter
open_locale big_operators

section semiring

variables {ι 𝕜 F : Type*} [fintype ι] [semiring 𝕜] [topological_space 𝕜]
  [add_comm_monoid F] [module 𝕜 F] [topological_space F]
  [has_continuous_add F] [has_continuous_smul 𝕜 F]

/-- A linear map on `ι → 𝕜` (where `ι` is a fintype) is continuous -/
lemma linear_map.continuous_on_pi (f : (ι → 𝕜) →ₗ[𝕜] F) : continuous f :=
begin
  classical,
  -- for the proof, write `f` in the standard basis, and use that each coordinate is a continuous
  -- function.
  have : (f : (ι → 𝕜) → F) =
         (λx, ∑ i : ι, x i • (f (λ j, if i = j then 1 else 0))),
    by { ext x, exact f.pi_apply_eq_sum_univ x },
  rw this,
  refine continuous_finset_sum _ (λi hi, _),
  exact (continuous_apply i).smul continuous_const
end

end semiring

section field

variables {ι 𝕜 E F : Type*} [fintype ι] [field 𝕜] [topological_space 𝕜]
  [add_comm_group E] [module 𝕜 E] [topological_space E]
  [add_comm_group F] [module 𝕜 F] [topological_space F]
  [topological_add_group F] [has_continuous_smul 𝕜 F]

/-- The space of continuous linear maps between finite-dimensional spaces is finite-dimensional. -/
instance [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F] :
  finite_dimensional 𝕜 (E →L[𝕜] F) :=
finite_dimensional.of_injective
  (continuous_linear_map.coe_lm 𝕜 : (E →L[𝕜] F) →ₗ[𝕜] (E →ₗ[𝕜] F))
  continuous_linear_map.coe_injective

end field

section normed_field

variables {𝕜 : Type u} [hnorm : nondiscrete_normed_field 𝕜]
  {E : Type v} [add_comm_group E] [module 𝕜 E] [topological_space E]
  [topological_add_group E] [has_continuous_smul 𝕜 E]
  {F : Type w} [add_comm_group F] [module 𝕜 F] [topological_space F]
  [topological_add_group F] [has_continuous_smul 𝕜 F]
  {F' : Type x} [add_comm_group F'] [module 𝕜 F'] [topological_space F']
  [topological_add_group F'] [has_continuous_smul 𝕜 F']

include hnorm

/-- If `𝕜` is a nondiscrete normed field, any T2 topology on `𝕜` which makes it a topological vector
    space over itself (with the norm topology) is *equal* to the norm topology. -/
lemma unique_topology_of_t2 {t : topological_space 𝕜}
  (h₁ : @topological_add_group 𝕜 t _)
  (h₂ : @has_continuous_smul 𝕜 𝕜 _ hnorm.to_uniform_space.to_topological_space t)
  (h₃ : @t2_space 𝕜 t) :
  t = hnorm.to_uniform_space.to_topological_space :=
begin
  -- Let `𝓣₀` denote the topology on `𝕜` induced by the norm, and `𝓣` be any T2 vector
  -- topology on `𝕜`. To show that `𝓣₀ = 𝓣`, it suffices to show that they have the same
  -- neighborhoods of 0.
  refine topological_add_group.ext h₁ infer_instance (le_antisymm _ _),
  { -- To show `𝓣 ≤ 𝓣₀`, we have to show that closed balls are `𝓣`-neighborhoods of 0.
    rw metric.nhds_basis_closed_ball.ge_iff,
    -- Let `ε > 0`. Since `𝕜` is nondiscrete, we have `0 < ∥ξ₀∥ < ε` for some `ξ₀ : 𝕜`.
    intros ε hε,
    rcases normed_field.exists_norm_lt 𝕜 hε with ⟨ξ₀, hξ₀, hξ₀ε⟩,
    -- Since `ξ₀ ≠ 0` and `𝓣` is T2, we know that `{ξ₀}ᶜ` is a `𝓣`-neighborhood of 0.
    have : {ξ₀}ᶜ ∈ @nhds 𝕜 t 0 :=
      is_open.mem_nhds is_open_compl_singleton (ne.symm $ norm_ne_zero_iff.mp hξ₀.ne.symm),
    -- Thus, its balanced core `𝓑` is too. Let's show that the closed ball of radius `ε` contains
    -- `𝓑`, which will imply that the closed ball is indeed a `𝓣`-neighborhood of 0.
    have : balanced_core 𝕜 {ξ₀}ᶜ ∈ @nhds 𝕜 t 0 := balanced_core_mem_nhds_zero this,
    refine mem_of_superset this (λ ξ hξ, _),
    -- Let `ξ ∈ 𝓑`. We want to show `∥ξ∥ < ε`. If `ξ = 0`, this is trivial.
    by_cases hξ0 : ξ = 0,
    { rw hξ0,
      exact metric.mem_closed_ball_self hε.le },
    { rw [mem_closed_ball_zero_iff],
      -- Now suppose `ξ ≠ 0`. By contradiction, let's assume `ε < ∥ξ∥`, and show that
      -- `ξ₀ ∈ 𝓑 ⊆ {ξ₀}ᶜ`, which is a contradiction.
      by_contra' h,
      suffices : (ξ₀ * ξ⁻¹) • ξ ∈ balanced_core 𝕜 {ξ₀}ᶜ,
      { rw [smul_eq_mul 𝕜, mul_assoc, inv_mul_cancel hξ0, mul_one] at this,
        exact not_mem_compl_iff.mpr (mem_singleton ξ₀) ((balanced_core_subset _) this) },
      -- For that, we use that `𝓑` is balanced : since `∥ξ₀∥ < ε < ∥ξ∥`, we have `∥ξ₀ / ξ∥ ≤ 1`,
      -- hence `ξ₀ = (ξ₀ / ξ) • ξ ∈ 𝓑` because `ξ ∈ 𝓑`.
      refine balanced_mem (balanced_core_balanced _) hξ _,
      rw [norm_mul, norm_inv, mul_inv_le_iff (norm_pos_iff.mpr hξ0), mul_one],
      exact (hξ₀ε.trans h).le } },
  { -- Finally, to show `𝓣₀ ≤ 𝓣`, we simply argue that `id = (λ x, x • 1)` is continuous from
    -- `(𝕜, 𝓣₀)` to `(𝕜, 𝓣)` because `(•) : (𝕜, 𝓣₀) × (𝕜, 𝓣) → (𝕜, 𝓣)` is continuous.
    calc (@nhds 𝕜 hnorm.to_uniform_space.to_topological_space 0)
        = map id (@nhds 𝕜 hnorm.to_uniform_space.to_topological_space 0) : map_id.symm
    ... = map (λ x, id x • 1) (@nhds 𝕜 hnorm.to_uniform_space.to_topological_space 0) :
        by conv_rhs {congr, funext, rw [smul_eq_mul, mul_one]}; refl
    ... ≤ (@nhds 𝕜 t ((0 : 𝕜) • 1)) :
        @tendsto.smul_const _ _ _ hnorm.to_uniform_space.to_topological_space t _ _ _ _ _
          tendsto_id (1 : 𝕜)
    ... = (@nhds 𝕜 t 0) : by rw zero_smul }
end

/-- Any linear form on a topological vector space over a nondiscrete normed field is continuous if
    its kernel is closed. -/
lemma linear_map.continuous_of_is_closed_ker (l : E →ₗ[𝕜] 𝕜) (hl : is_closed (l.ker : set E)) :
  continuous l :=
begin
  -- `l` is either constant or surjective. If it is constant, the result is trivial.
  by_cases H : finrank 𝕜 l.range = 0,
  { rw [finrank_eq_zero, linear_map.range_eq_bot] at H,
    rw H,
    exact continuous_zero },
  { -- In the case where `l` is surjective, we factor it as `φ : (E ⧸ l.ker) ≃ₗ[𝕜] 𝕜`. Note that
    -- `E ⧸ l.ker` is T2 since `l.ker` is closed.
    have : finrank 𝕜 l.range = 1,
      from le_antisymm (finrank_self 𝕜 ▸ l.range.finrank_le) (zero_lt_iff.mpr H),
    have hi : function.injective (l.ker.liftq l (le_refl _)),
    { rw [← linear_map.ker_eq_bot],
      exact submodule.ker_liftq_eq_bot _ _ _ (le_refl _) },
    have hs : function.surjective (l.ker.liftq l (le_refl _)),
    { rw [← linear_map.range_eq_top, submodule.range_liftq],
      exact eq_top_of_finrank_eq ((finrank_self 𝕜).symm ▸ this) },
    let φ : (E ⧸ l.ker) ≃ₗ[𝕜] 𝕜 := linear_equiv.of_bijective (l.ker.liftq l (le_refl _)) hi hs,
    have hlφ : (l : E → 𝕜) = φ ∘ l.ker.mkq,
      by ext; refl,
    -- Since the quotient map `E →ₗ[𝕜] (E ⧸ l.ker)` is continuous, the continuity of `l` will follow
    -- form the continuity of `φ`.
    suffices : continuous φ.to_equiv,
    { rw hlφ,
      exact this.comp continuous_quot_mk },
    -- The pullback by `φ.symm` of the quotient topology is a T2 topology on `𝕜`, because `φ.symm`
    -- is injective. Since `φ.symm` is linear, it is also a vector space topology.
    -- Hence, we know that it is equal to the topology induced by the norm.
    have : induced φ.to_equiv.symm infer_instance = hnorm.to_uniform_space.to_topological_space,
    { refine unique_topology_of_t2 (topological_add_group_induced φ.symm.to_linear_map)
        (has_continuous_smul_induced φ.symm.to_linear_map) _,
      rw t2_space_iff,
      exact λ x y hxy, @separated_by_continuous _ _ (induced _ _) _ _ _
        continuous_induced_dom _ _ (φ.to_equiv.symm.injective.ne hxy) },
    -- Finally, the pullback by `φ.symm` is exactly the pushforward by `φ`, so we have to prove
    -- that `φ` is continuous when `𝕜` is endowed with the pushforward by `φ` of the quotient
    -- topology, which is trivial by definition of the pushforward.
    rw [this.symm, equiv.induced_symm],
    exact continuous_coinduced_rng }
end

/-- Any linear form on a topological vector space over a nondiscrete normed field is continuous if
    and only if its kernel is closed. -/
lemma linear_map.continuous_iff_is_closed_ker (l : E →ₗ[𝕜] 𝕜) :
  continuous l ↔ is_closed (l.ker : set E) :=
⟨λ h, is_closed_singleton.preimage h, l.continuous_of_is_closed_ker⟩

variables [complete_space 𝕜]

/-- This version imposes `ι` and `E` to live in the same universe, so you should instead use
`continuous_equiv_fun_basis` which gives the same result without universe restrictions. -/
private lemma continuous_equiv_fun_basis_aux [ht2 : t2_space E] {ι : Type v} [fintype ι]
  (ξ : basis ι 𝕜 E) : continuous ξ.equiv_fun :=
begin
  letI : uniform_space E := topological_add_group.to_uniform_space E,
  letI : uniform_add_group E := topological_add_group_is_uniform,
  letI : separated_space E := separated_iff_t2.mpr ht2,
  unfreezingI { induction hn : fintype.card ι with n IH generalizing ι E },
  { rw fintype.card_eq_zero_iff at hn,
    exact continuous_of_const (λ x y, funext hn.elim) },
  { haveI : finite_dimensional 𝕜 E := of_fintype_basis ξ,
    -- first step: thanks to the induction hypothesis, any n-dimensional subspace is equivalent
    -- to a standard space of dimension n, hence it is complete and therefore closed.
    have H₁ : ∀s : submodule 𝕜 E, finrank 𝕜 s = n → is_closed (s : set E),
    { assume s s_dim,
      letI : uniform_add_group s := s.to_add_subgroup.uniform_add_group,
      let b := basis.of_vector_space 𝕜 s,
      have U : uniform_embedding b.equiv_fun.symm.to_equiv,
      { have : fintype.card (basis.of_vector_space_index 𝕜 s) = n,
          by { rw ← s_dim, exact (finrank_eq_card_basis b).symm },
        have : continuous b.equiv_fun := IH b this,
        exact b.equiv_fun.symm.uniform_embedding b.equiv_fun.symm.to_linear_map.continuous_on_pi
          this },
      have : is_complete (s : set E),
        from complete_space_coe_iff_is_complete.1 ((complete_space_congr U).1 (by apply_instance)),
      exact this.is_closed },
    -- second step: any linear form is continuous, as its kernel is closed by the first step
    have H₂ : ∀f : E →ₗ[𝕜] 𝕜, continuous f,
    { assume f,
      by_cases H : finrank 𝕜 f.range = 0,
      { rw [finrank_eq_zero, linear_map.range_eq_bot] at H,
        rw H,
        exact continuous_zero },
      { have : finrank 𝕜 f.ker = n,
        { have Z := f.finrank_range_add_finrank_ker,
          rw [finrank_eq_card_basis ξ, hn] at Z,
          have : finrank 𝕜 f.range = 1,
            from le_antisymm (finrank_self 𝕜 ▸ f.range.finrank_le) (zero_lt_iff.mpr H),
          rw [this, add_comm, nat.add_one] at Z,
          exact nat.succ.inj Z },
        have : is_closed (f.ker : set E),
          from H₁ _ this,
        exact linear_map.continuous_of_is_closed_ker f this } },
    rw continuous_pi_iff,
    intros i,
    change continuous (ξ.coord i),
    exact H₂ (ξ.coord i) },
end

/-- Any linear map on a finite dimensional space over a complete field is continuous. -/
theorem linear_map.continuous_of_finite_dimensional [t2_space E] [finite_dimensional 𝕜 E]
  (f : E →ₗ[𝕜] F') :
  continuous f :=
begin
  -- for the proof, go to a model vector space `b → 𝕜` thanks to `continuous_equiv_fun_basis`, and
  -- argue that all linear maps there are continuous.
  let b := basis.of_vector_space 𝕜 E,
  have A : continuous b.equiv_fun :=
    continuous_equiv_fun_basis_aux b,
  have B : continuous (f.comp (b.equiv_fun.symm : (basis.of_vector_space_index 𝕜 E → 𝕜) →ₗ[𝕜] E)) :=
    linear_map.continuous_on_pi _,
  have : continuous ((f.comp (b.equiv_fun.symm : (basis.of_vector_space_index 𝕜 E → 𝕜) →ₗ[𝕜] E))
                      ∘ b.equiv_fun) := B.comp A,
  convert this,
  ext x,
  dsimp,
  rw [basis.equiv_fun_symm_apply, basis.sum_repr]
end

/-- In finite dimensions over a non-discrete complete normed field, the canonical identification
(in terms of a basis) with `𝕜^n` (endowed with the product topology) is continuous.
This is the key fact wich makes all linear maps from a T2 finite dimensional TVS over such a field
continuous (see `linear_map.continuous_of_finite_dimensional`), which in turn implies that all
norms are equivalent in finite dimensions. -/
theorem continuous_equiv_fun_basis [t2_space E] {ι : Type*} [fintype ι] (ξ : basis ι 𝕜 E) :
  continuous ξ.equiv_fun :=
begin
  haveI : finite_dimensional 𝕜 E := of_fintype_basis ξ,
  exact ξ.equiv_fun.to_linear_map.continuous_of_finite_dimensional
end

namespace linear_map

variables [t2_space E] [finite_dimensional 𝕜 E]

/-- The continuous linear map induced by a linear map on a finite dimensional space -/
def to_continuous_linear_map : (E →ₗ[𝕜] F') ≃ₗ[𝕜] E →L[𝕜] F' :=
{ to_fun := λ f, ⟨f, f.continuous_of_finite_dimensional⟩,
  inv_fun := coe,
  map_add' := λ f g, rfl,
  map_smul' := λ c f, rfl,
  left_inv := λ f, rfl,
  right_inv := λ f, continuous_linear_map.coe_injective rfl }

@[simp] lemma coe_to_continuous_linear_map' (f : E →ₗ[𝕜] F') :
  ⇑f.to_continuous_linear_map = f := rfl

@[simp] lemma coe_to_continuous_linear_map (f : E →ₗ[𝕜] F') :
  (f.to_continuous_linear_map : E →ₗ[𝕜] F') = f := rfl

@[simp] lemma coe_to_continuous_linear_map_symm :
  ⇑(to_continuous_linear_map : (E →ₗ[𝕜] F') ≃ₗ[𝕜] E →L[𝕜] F').symm = coe := rfl

end linear_map

namespace linear_equiv

variables [t2_space E] [t2_space F] [finite_dimensional 𝕜 E]

/-- The continuous linear equivalence induced by a linear equivalence on a finite dimensional
space. -/
def to_continuous_linear_equiv (e : E ≃ₗ[𝕜] F) : E ≃L[𝕜] F :=
{ continuous_to_fun := e.to_linear_map.continuous_of_finite_dimensional,
  continuous_inv_fun := begin
    haveI : finite_dimensional 𝕜 F := e.finite_dimensional,
    exact e.symm.to_linear_map.continuous_of_finite_dimensional
  end,
  ..e }

@[simp] lemma coe_to_continuous_linear_equiv (e : E ≃ₗ[𝕜] F) :
  (e.to_continuous_linear_equiv : E →ₗ[𝕜] F) = e := rfl

@[simp] lemma coe_to_continuous_linear_equiv' (e : E ≃ₗ[𝕜] F) :
  (e.to_continuous_linear_equiv : E → F) = e := rfl

@[simp] lemma coe_to_continuous_linear_equiv_symm (e : E ≃ₗ[𝕜] F) :
  (e.to_continuous_linear_equiv.symm : F →ₗ[𝕜] E) = e.symm := rfl

@[simp] lemma coe_to_continuous_linear_equiv_symm' (e : E ≃ₗ[𝕜] F) :
  (e.to_continuous_linear_equiv.symm : F → E) = e.symm := rfl

@[simp] lemma to_linear_equiv_to_continuous_linear_equiv (e : E ≃ₗ[𝕜] F) :
  e.to_continuous_linear_equiv.to_linear_equiv = e :=
by { ext x, refl }

@[simp] lemma to_linear_equiv_to_continuous_linear_equiv_symm (e : E ≃ₗ[𝕜] F) :
  e.to_continuous_linear_equiv.symm.to_linear_equiv = e.symm :=
by { ext x, refl }

end linear_equiv

namespace continuous_linear_map

variables [t2_space E] [finite_dimensional 𝕜 E]

/-- Builds a continuous linear equivalence from a continuous linear map on a finite-dimensional
vector space whose determinant is nonzero. -/
def to_continuous_linear_equiv_of_det_ne_zero
  (f : E →L[𝕜] E) (hf : f.det ≠ 0) : E ≃L[𝕜] E :=
((f : E →ₗ[𝕜] E).equiv_of_det_ne_zero hf).to_continuous_linear_equiv

@[simp] lemma coe_to_continuous_linear_equiv_of_det_ne_zero (f : E →L[𝕜] E) (hf : f.det ≠ 0) :
  (f.to_continuous_linear_equiv_of_det_ne_zero hf : E →L[𝕜] E) = f :=
by { ext x, refl }

@[simp] lemma to_continuous_linear_equiv_of_det_ne_zero_apply
  (f : E →L[𝕜] E) (hf : f.det ≠ 0) (x : E) :
  f.to_continuous_linear_equiv_of_det_ne_zero hf x = f x :=
rfl

end continuous_linear_map

end normed_field


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

! This file was ported from Lean 3 source module topology.gluing
! leanprover-community/mathlib commit d39590fc8728fbf6743249802486f8c91ffe07bc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.GlueData
import Mathbin.CategoryTheory.ConcreteCategory.Elementwise
import Mathbin.Topology.Category.Top.Limits
import Mathbin.Topology.Category.Top.Opens

/-!
# Gluing Topological spaces

Given a family of gluing data (see `category_theory/glue_data`), we can then glue them together.

The construction should be "sealed" and considered as a black box, while only using the API
provided.

## Main definitions

* `Top.glue_data`: A structure containing the family of gluing data.
* `category_theory.glue_data.glued`: The glued topological space.
    This is defined as the multicoequalizer of `∐ V i j ⇉ ∐ U i`, so that the general colimit API
    can be used.
* `category_theory.glue_data.ι`: The immersion `ι i : U i ⟶ glued` for each `i : ι`.
* `Top.glue_data.rel`: A relation on `Σ i, D.U i` defined by `⟨i, x⟩ ~ ⟨j, y⟩` iff
    `⟨i, x⟩ = ⟨j, y⟩` or `t i j x = y`. See `Top.glue_data.ι_eq_iff_rel`.
* `Top.glue_data.mk`: A constructor of `glue_data` whose conditions are stated in terms of
  elements rather than subobjects and pullbacks.
* `Top.glue_data.of_open_subsets`: Given a family of open sets, we may glue them into a new
  topological space. This new space embeds into the original space, and is homeomorphic to it if
  the given family is an open cover (`Top.glue_data.open_cover_glue_homeo`).

## Main results

* `Top.glue_data.is_open_iff`: A set in `glued` is open iff its preimage along each `ι i` is
    open.
* `Top.glue_data.ι_jointly_surjective`: The `ι i`s are jointly surjective.
* `Top.glue_data.rel_equiv`: `rel` is an equivalence relation.
* `Top.glue_data.ι_eq_iff_rel`: `ι i x = ι j y ↔ ⟨i, x⟩ ~ ⟨j, y⟩`.
* `Top.glue_data.image_inter`: The intersection of the images of `U i` and `U j` in `glued` is
    `V i j`.
* `Top.glue_data.preimage_range`: The preimage of the image of `U i` in `U j` is `V i j`.
* `Top.glue_data.preimage_image_eq_preimage_f`: The preimage of the image of some `U ⊆ U i` is
    given by the preimage along `f j i`.
* `Top.glue_data.ι_open_embedding`: Each of the `ι i`s are open embeddings.

-/

noncomputable section

open TopologicalSpace CategoryTheory

universe v u

open CategoryTheory.Limits

namespace TopCat

/-- A family of gluing data consists of
1. An index type `J`
2. An object `U i` for each `i : J`.
3. An object `V i j` for each `i j : J`.
  (Note that this is `J × J → Top` rather than `J → J → Top` to connect to the
  limits library easier.)
4. An open embedding `f i j : V i j ⟶ U i` for each `i j : ι`.
5. A transition map `t i j : V i j ⟶ V j i` for each `i j : ι`.
such that
6. `f i i` is an isomorphism.
7. `t i i` is the identity.
8. `V i j ×[U i] V i k ⟶ V i j ⟶ V j i` factors through `V j k ×[U j] V j i ⟶ V j i` via some
    `t' : V i j ×[U i] V i k ⟶ V j k ×[U j] V j i`.
    (This merely means that `V i j ∩ V i k ⊆ t i j ⁻¹' (V j i ∩ V j k)`.)
9. `t' i j k ≫ t' j k i ≫ t' k i j = 𝟙 _`.

We can then glue the topological spaces `U i` together by identifying `V i j` with `V j i`, such
that the `U i`'s are open subspaces of the glued space.

Most of the times it would be easier to use the constructor `Top.glue_data.mk'` where the conditions
are stated in a less categorical way.
-/
@[nolint has_nonempty_instance]
structure GlueData extends GlueData TopCat where
  f_open : ∀ i j, OpenEmbedding (f i j)
  f_mono := fun i j => (TopCat.mono_iff_injective _).mpr (f_open i j).toEmbedding.inj
#align Top.glue_data TopCat.GlueData

namespace GlueData

variable (D : GlueData.{u})

-- mathport name: «expr𝖣»
local notation "𝖣" => D.toGlueData

theorem π_surjective : Function.Surjective 𝖣.π :=
  (TopCat.epi_iff_surjective 𝖣.π).mp inferInstance
#align Top.glue_data.π_surjective TopCat.GlueData.π_surjective

theorem isOpen_iff (U : Set 𝖣.glued) : IsOpen U ↔ ∀ i, IsOpen (𝖣.ι i ⁻¹' U) :=
  by
  delta CategoryTheory.GlueData.ι
  simp_rw [← multicoequalizer.ι_sigma_π 𝖣.diagram]
  rw [← (homeo_of_iso (multicoequalizer.iso_coequalizer 𝖣.diagram).symm).isOpen_preimage]
  rw [coequalizer_is_open_iff, colimit_isOpen_iff.{u}]
  constructor
  · intro h j
    exact h ⟨j⟩
  · intro h j
    cases j
    exact h j
#align Top.glue_data.is_open_iff TopCat.GlueData.isOpen_iff

theorem ι_jointly_surjective (x : 𝖣.glued) : ∃ (i : _)(y : D.U i), 𝖣.ι i y = x :=
  𝖣.ι_jointly_surjective (forget TopCat) x
#align Top.glue_data.ι_jointly_surjective TopCat.GlueData.ι_jointly_surjective

/-- An equivalence relation on `Σ i, D.U i` that holds iff `𝖣 .ι i x = 𝖣 .ι j y`.
See `Top.glue_data.ι_eq_iff_rel`.
-/
def Rel (a b : Σi, ((D.U i : TopCat) : Type _)) : Prop :=
  a = b ∨ ∃ x : D.V (a.1, b.1), D.f _ _ x = a.2 ∧ D.f _ _ (D.t _ _ x) = b.2
#align Top.glue_data.rel TopCat.GlueData.Rel

theorem rel_equiv : Equivalence D.Rel :=
  ⟨fun x => Or.inl (refl x), by
    rintro a b (⟨⟨⟩⟩ | ⟨x, e₁, e₂⟩)
    exacts[Or.inl rfl, Or.inr ⟨D.t _ _ x, by simp [e₁, e₂]⟩],
    by
    rintro ⟨i, a⟩ ⟨j, b⟩ ⟨k, c⟩ (⟨⟨⟩⟩ | ⟨x, e₁, e₂⟩)
    exact id
    rintro (⟨⟨⟩⟩ | ⟨y, e₃, e₄⟩)
    exact Or.inr ⟨x, e₁, e₂⟩
    let z := (pullback_iso_prod_subtype (D.f j i) (D.f j k)).inv ⟨⟨_, _⟩, e₂.trans e₃.symm⟩
    have eq₁ : (D.t j i) ((pullback.fst : _ ⟶ D.V _) z) = x := by simp
    have eq₂ : (pullback.snd : _ ⟶ D.V _) z = y := pullback_iso_prod_subtype_inv_snd_apply _ _ _
    clear_value z
    right
    use (pullback.fst : _ ⟶ D.V (i, k)) (D.t' _ _ _ z)
    dsimp only at *
    substs e₁ e₃ e₄ eq₁ eq₂
    have h₁ : D.t' j i k ≫ pullback.fst ≫ D.f i k = pullback.fst ≫ D.t j i ≫ D.f i j :=
      by
      rw [← 𝖣.t_fac_assoc]
      congr 1
      exact pullback.condition
    have h₂ : D.t' j i k ≫ pullback.fst ≫ D.t i k ≫ D.f k i = pullback.snd ≫ D.t j k ≫ D.f k j :=
      by
      rw [← 𝖣.t_fac_assoc]
      apply @epi.left_cancellation _ _ _ _ (D.t' k j i)
      rw [𝖣.cocycle_assoc, 𝖣.t_fac_assoc, 𝖣.t_inv_assoc]
      exact pullback.condition.symm
    exact ⟨ContinuousMap.congr_fun h₁ z, ContinuousMap.congr_fun h₂ z⟩⟩
#align Top.glue_data.rel_equiv TopCat.GlueData.rel_equiv

open CategoryTheory.Limits.WalkingParallelPair

theorem eqvGen_of_π_eq {x y : ∐ D.U} (h : 𝖣.π x = 𝖣.π y) :
    EqvGen (Types.CoequalizerRel 𝖣.diagram.fstSigmaMap 𝖣.diagram.sndSigmaMap) x y :=
  by
  delta glue_data.π multicoequalizer.sigma_π at h
  simp_rw [comp_app] at h
  replace h := (TopCat.mono_iff_injective (multicoequalizer.iso_coequalizer 𝖣.diagram).inv).mp _ h
  let diagram := parallel_pair 𝖣.diagram.fstSigmaMap 𝖣.diagram.sndSigmaMap ⋙ forget _
  have : colimit.ι diagram one x = colimit.ι diagram one y :=
    by
    rw [← ι_preserves_colimits_iso_hom]
    simp [h]
  have :
    (colimit.ι diagram _ ≫ colim.map _ ≫ (colimit.iso_colimit_cocone _).Hom) _ =
      (colimit.ι diagram _ ≫ colim.map _ ≫ (colimit.iso_colimit_cocone _).Hom) _ :=
    (congr_arg
        (colim.map (diagram_iso_parallel_pair diagram).Hom ≫
          (colimit.iso_colimit_cocone (types.coequalizer_colimit _ _)).Hom)
        this :
      _)
  simp only [eq_to_hom_refl, types_comp_apply, colimit.ι_map_assoc,
    diagram_iso_parallel_pair_hom_app, colimit.iso_colimit_cocone_ι_hom, types_id_apply] at this
  exact Quot.eq.1 this
  infer_instance
#align Top.glue_data.eqv_gen_of_π_eq TopCat.GlueData.eqvGen_of_π_eq

theorem ι_eq_iff_rel (i j : D.J) (x : D.U i) (y : D.U j) :
    𝖣.ι i x = 𝖣.ι j y ↔ D.Rel ⟨i, x⟩ ⟨j, y⟩ :=
  by
  constructor
  · delta glue_data.ι
    simp_rw [← multicoequalizer.ι_sigma_π]
    intro h
    rw [←
      show _ = Sigma.mk i x from concrete_category.congr_hom (sigmaIsoSigma.{u} D.U).inv_hom_id _]
    rw [←
      show _ = Sigma.mk j y from concrete_category.congr_hom (sigmaIsoSigma.{u} D.U).inv_hom_id _]
    change InvImage D.rel (sigmaIsoSigma.{u} D.U).Hom _ _
    simp only [TopCat.sigmaIsoSigma_inv_apply]
    rw [← (InvImage.equivalence _ _ D.rel_equiv).eqvGen_iff]
    refine' EqvGen.mono _ (D.eqv_gen_of_π_eq h : _)
    rintro _ _ ⟨x⟩
    rw [←
      show (sigmaIsoSigma.{u} _).inv _ = x from
        concrete_category.congr_hom (sigmaIsoSigma.{u} _).hom_inv_id x]
    generalize (sigmaIsoSigma.{u} D.V).Hom x = x'
    obtain ⟨⟨i, j⟩, y⟩ := x'
    unfold InvImage multispan_index.fst_sigma_map multispan_index.snd_sigma_map
    simp only [opens.inclusion_apply, TopCat.comp_app, sigma_iso_sigma_inv_apply,
      CategoryTheory.Limits.colimit.ι_desc_apply, cofan.mk_ι_app, sigma_iso_sigma_hom_ι_apply,
      ContinuousMap.toFun_eq_coe]
    erw [sigma_iso_sigma_hom_ι_apply, sigma_iso_sigma_hom_ι_apply]
    exact
      Or.inr
        ⟨y, by
          dsimp [glue_data.diagram]
          simp⟩
  · rintro (⟨⟨⟩⟩ | ⟨z, e₁, e₂⟩)
    rfl
    dsimp only at *
    subst e₁
    subst e₂
    simp
#align Top.glue_data.ι_eq_iff_rel TopCat.GlueData.ι_eq_iff_rel

theorem ι_injective (i : D.J) : Function.Injective (𝖣.ι i) :=
  by
  intro x y h
  rcases(D.ι_eq_iff_rel _ _ _ _).mp h with (⟨⟨⟩⟩ | ⟨_, e₁, e₂⟩)
  · rfl
  · dsimp only at *
    cases e₁
    cases e₂
    simp
#align Top.glue_data.ι_injective TopCat.GlueData.ι_injective

instance ι_mono (i : D.J) : Mono (𝖣.ι i) :=
  (TopCat.mono_iff_injective _).mpr (D.ι_injective _)
#align Top.glue_data.ι_mono TopCat.GlueData.ι_mono

theorem image_inter (i j : D.J) :
    Set.range (𝖣.ι i) ∩ Set.range (𝖣.ι j) = Set.range (D.f i j ≫ 𝖣.ι _) :=
  by
  ext x
  constructor
  · rintro ⟨⟨x₁, eq₁⟩, ⟨x₂, eq₂⟩⟩
    obtain ⟨⟨⟩⟩ | ⟨y, e₁, e₂⟩ := (D.ι_eq_iff_rel _ _ _ _).mp (eq₁.trans eq₂.symm)
    · exact ⟨inv (D.f i i) x₁, by simp [eq₁]⟩
    · dsimp only at *
      substs e₁ eq₁
      exact ⟨y, by simp⟩
  · rintro ⟨x, hx⟩
    exact ⟨⟨D.f i j x, hx⟩, ⟨D.f j i (D.t _ _ x), by simp [← hx]⟩⟩
#align Top.glue_data.image_inter TopCat.GlueData.image_inter

theorem preimage_range (i j : D.J) : 𝖣.ι j ⁻¹' Set.range (𝖣.ι i) = Set.range (D.f j i) := by
  rw [← Set.preimage_image_eq (Set.range (D.f j i)) (D.ι_injective j), ← Set.image_univ, ←
    Set.image_univ, ← Set.image_comp, ← coe_comp, Set.image_univ, Set.image_univ, ← image_inter,
    Set.preimage_range_inter]
#align Top.glue_data.preimage_range TopCat.GlueData.preimage_range

theorem preimage_image_eq_image (i j : D.J) (U : Set (𝖣.U i)) :
    𝖣.ι j ⁻¹' (𝖣.ι i '' U) = D.f _ _ '' ((D.t j i ≫ D.f _ _) ⁻¹' U) :=
  by
  have : D.f _ _ ⁻¹' (𝖣.ι j ⁻¹' (𝖣.ι i '' U)) = (D.t j i ≫ D.f _ _) ⁻¹' U :=
    by
    ext x
    conv_rhs => rw [← Set.preimage_image_eq U (D.ι_injective _)]
    generalize 𝖣.ι i '' U = U'
    simp
  rw [← this, Set.image_preimage_eq_inter_range]
  symm
  apply Set.inter_eq_self_of_subset_left
  rw [← D.preimage_range i j]
  exact Set.preimage_mono (Set.image_subset_range _ _)
#align Top.glue_data.preimage_image_eq_image TopCat.GlueData.preimage_image_eq_image

theorem preimage_image_eq_image' (i j : D.J) (U : Set (𝖣.U i)) :
    𝖣.ι j ⁻¹' (𝖣.ι i '' U) = (D.t i j ≫ D.f _ _) '' (D.f _ _ ⁻¹' U) :=
  by
  convert D.preimage_image_eq_image i j U using 1
  rw [coe_comp, coe_comp, ← Set.image_image]
  congr 1
  rw [← Set.eq_preimage_iff_image_eq, Set.preimage_preimage]
  change _ = (D.t i j ≫ D.t j i ≫ _) ⁻¹' _
  rw [𝖣.t_inv_assoc]
  rw [← is_iso_iff_bijective]
  apply (forget TopCat).map_isIso
#align Top.glue_data.preimage_image_eq_image' TopCat.GlueData.preimage_image_eq_image'

theorem open_image_open (i : D.J) (U : Opens (𝖣.U i)) : IsOpen (𝖣.ι i '' U) :=
  by
  rw [is_open_iff]
  intro j
  rw [preimage_image_eq_image]
  apply (D.f_open _ _).IsOpenMap
  apply (D.t j i ≫ D.f i j).continuous_toFun.isOpen_preimage
  exact U.is_open
#align Top.glue_data.open_image_open TopCat.GlueData.open_image_open

theorem ι_openEmbedding (i : D.J) : OpenEmbedding (𝖣.ι i) :=
  openEmbedding_of_continuous_injective_open (𝖣.ι i).continuous_toFun (D.ι_injective i) fun U h =>
    D.open_image_open i ⟨U, h⟩
#align Top.glue_data.ι_open_embedding TopCat.GlueData.ι_openEmbedding

/-- A family of gluing data consists of
1. An index type `J`
2. A bundled topological space `U i` for each `i : J`.
3. An open set `V i j ⊆ U i` for each `i j : J`.
4. A transition map `t i j : V i j ⟶ V j i` for each `i j : ι`.
such that
6. `V i i = U i`.
7. `t i i` is the identity.
8. For each `x ∈ V i j ∩ V i k`, `t i j x ∈ V j k`.
9. `t j k (t i j x) = t i k x`.

We can then glue the topological spaces `U i` together by identifying `V i j` with `V j i`.
-/
@[nolint has_nonempty_instance]
structure MkCore where
  {J : Type u}
  U : J → TopCat.{u}
  V : ∀ i, J → Opens (U i)
  t : ∀ i j, (Opens.toTop _).obj (V i j) ⟶ (Opens.toTop _).obj (V j i)
  v_id : ∀ i, V i i = ⊤
  t_id : ∀ i, ⇑(t i i) = id
  t_inter : ∀ ⦃i j⦄ (k) (x : V i j), ↑x ∈ V i k → @coe (V j i) (U j) _ (t i j x) ∈ V j k
  cocycle :
    ∀ (i j k) (x : V i j) (h : ↑x ∈ V i k),
      @coe (V k j) (U k) _ (t j k ⟨↑(t i j x), t_inter k x h⟩) = @coe (V k i) (U k) _ (t i k ⟨x, h⟩)
#align Top.glue_data.mk_core TopCat.GlueData.MkCore

theorem MkCore.t_inv (h : MkCore) (i j : h.J) (x : h.V j i) : h.t i j ((h.t j i) x) = x :=
  by
  have := h.cocycle j i j x _
  rw [h.t_id] at this
  convert Subtype.eq this
  · ext
    rfl
  all_goals rw [h.V_id]; trivial
#align Top.glue_data.mk_core.t_inv TopCat.GlueData.MkCore.t_inv

instance (h : MkCore.{u}) (i j : h.J) : IsIso (h.t i j) :=
  by
  use h.t j i
  constructor <;> ext1
  exacts[h.t_inv _ _ _, h.t_inv _ _ _]

/-- (Implementation) the restricted transition map to be fed into `glue_data`. -/
def MkCore.t' (h : MkCore.{u}) (i j k : h.J) :
    pullback (h.V i j).inclusion (h.V i k).inclusion ⟶
      pullback (h.V j k).inclusion (h.V j i).inclusion :=
  by
  refine' (pullback_iso_prod_subtype _ _).Hom ≫ ⟨_, _⟩ ≫ (pullback_iso_prod_subtype _ _).inv
  · intro x
    refine' ⟨⟨⟨(h.t i j x.1.1).1, _⟩, h.t i j x.1.1⟩, rfl⟩
    rcases x with ⟨⟨⟨x, hx⟩, ⟨x', hx'⟩⟩, rfl : x = x'⟩
    exact h.t_inter _ ⟨x, hx⟩ hx'
  continuity
#align Top.glue_data.mk_core.t' TopCat.GlueData.MkCore.t'

/-- This is a constructor of `Top.glue_data` whose arguments are in terms of elements and
intersections rather than subobjects and pullbacks. Please refer to `Top.glue_data.mk_core` for
details. -/
def mk' (h : MkCore.{u}) : TopCat.GlueData
    where
  J := h.J
  U := h.U
  V i := (Opens.toTop _).obj (h.V i.1 i.2)
  f i j := (h.V i j).inclusion
  f_id i := (h.v_id i).symm ▸ IsIso.of_iso (Opens.inclusionTopIso (h.U i))
  f_open := fun i j : h.J => (h.V i j).OpenEmbedding
  t := h.t
  t_id i := by
    ext
    rw [h.t_id]
    rfl
  t' := h.t'
  t_fac i j k := by
    delta mk_core.t'
    rw [category.assoc, category.assoc, pullback_iso_prod_subtype_inv_snd, ← iso.eq_inv_comp,
      pullback_iso_prod_subtype_inv_fst_assoc]
    ext ⟨⟨⟨x, hx⟩, ⟨x', hx'⟩⟩, rfl : x = x'⟩
    rfl
  cocycle i j k := by
    delta mk_core.t'
    simp_rw [← category.assoc]
    rw [iso.comp_inv_eq]
    simp only [iso.inv_hom_id_assoc, category.assoc, category.id_comp]
    rw [← iso.eq_inv_comp, iso.inv_hom_id]
    ext1 ⟨⟨⟨x, hx⟩, ⟨x', hx'⟩⟩, rfl : x = x'⟩
    simp only [TopCat.comp_app, ContinuousMap.coe_mk, Prod.mk.inj_iff, TopCat.id_app,
      Subtype.mk_eq_mk, Subtype.coe_mk]
    rw [← subtype.coe_injective.eq_iff, Subtype.val_eq_coe, Subtype.coe_mk, and_self_iff]
    convert congr_arg coe (h.t_inv k i ⟨x, hx'⟩) using 3
    ext
    exact h.cocycle i j k ⟨x, hx⟩ hx'
#align Top.glue_data.mk' TopCat.GlueData.mk'

variable {α : Type u} [TopologicalSpace α] {J : Type u} (U : J → Opens α)

include U

/-- We may construct a glue data from a family of open sets. -/
@[simps to_glue_data_J to_glue_data_U to_glue_data_V to_glue_data_t to_glue_data_f]
def ofOpenSubsets : TopCat.GlueData.{u} :=
  mk'.{u}
    { J
      U := fun i => (Opens.toTop <| TopCat.of α).obj (U i)
      V := fun i j => (Opens.map <| Opens.inclusion _).obj (U j)
      t := fun i j => ⟨fun x => ⟨⟨x.1.1, x.2⟩, x.1.2⟩, by continuity⟩
      v_id := fun i => by
        ext
        cases U i
        simp
      t_id := fun i => by
        ext
        rfl
      t_inter := fun i j k x hx => hx
      cocycle := fun i j k x h => rfl }
#align Top.glue_data.of_open_subsets TopCat.GlueData.ofOpenSubsets

/-- The canonical map from the glue of a family of open subsets `α` into `α`.
This map is an open embedding (`from_open_subsets_glue_open_embedding`),
and its range is `⋃ i, (U i : set α)` (`range_from_open_subsets_glue`).
-/
def fromOpenSubsetsGlue : (ofOpenSubsets U).toGlueData.glued ⟶ TopCat.of α :=
  Multicoequalizer.desc _ _ (fun x => Opens.inclusion _)
    (by
      rintro ⟨i, j⟩
      ext x
      rfl)
#align Top.glue_data.from_open_subsets_glue TopCat.GlueData.fromOpenSubsetsGlue

@[simp, elementwise]
theorem ι_fromOpenSubsetsGlue (i : J) :
    (ofOpenSubsets U).toGlueData.ι i ≫ fromOpenSubsetsGlue U = Opens.inclusion _ :=
  Multicoequalizer.π_desc _ _ _ _ _
#align Top.glue_data.ι_from_open_subsets_glue TopCat.GlueData.ι_fromOpenSubsetsGlue

theorem fromOpenSubsetsGlue_injective : Function.Injective (fromOpenSubsetsGlue U) :=
  by
  intro x y e
  obtain ⟨i, ⟨x, hx⟩, rfl⟩ := (of_open_subsets U).ι_jointly_surjective x
  obtain ⟨j, ⟨y, hy⟩, rfl⟩ := (of_open_subsets U).ι_jointly_surjective y
  rw [ι_from_open_subsets_glue_apply, ι_from_open_subsets_glue_apply] at e
  change x = y at e
  subst e
  rw [(of_open_subsets U).ι_eq_iff_rel]
  right
  exact ⟨⟨⟨x, hx⟩, hy⟩, rfl, rfl⟩
#align Top.glue_data.from_open_subsets_glue_injective TopCat.GlueData.fromOpenSubsetsGlue_injective

theorem fromOpenSubsetsGlue_isOpenMap : IsOpenMap (fromOpenSubsetsGlue U) :=
  by
  intro s hs
  rw [(of_open_subsets U).isOpen_iff] at hs
  rw [isOpen_iff_forall_mem_open]
  rintro _ ⟨x, hx, rfl⟩
  obtain ⟨i, ⟨x, hx'⟩, rfl⟩ := (of_open_subsets U).ι_jointly_surjective x
  use from_open_subsets_glue U '' s ∩ Set.range (@opens.inclusion (TopCat.of α) (U i))
  use Set.inter_subset_left _ _
  constructor
  · erw [← Set.image_preimage_eq_inter_range]
    apply (@opens.open_embedding (TopCat.of α) (U i)).IsOpenMap
    convert hs i using 1
    rw [← ι_from_open_subsets_glue, coe_comp, Set.preimage_comp]
    congr 1
    refine' Set.preimage_image_eq _ (from_open_subsets_glue_injective U)
  · refine' ⟨Set.mem_image_of_mem _ hx, _⟩
    rw [ι_from_open_subsets_glue_apply]
    exact Set.mem_range_self _
#align Top.glue_data.from_open_subsets_glue_is_open_map TopCat.GlueData.fromOpenSubsetsGlue_isOpenMap

theorem fromOpenSubsetsGlue_openEmbedding : OpenEmbedding (fromOpenSubsetsGlue U) :=
  openEmbedding_of_continuous_injective_open (ContinuousMap.continuous_toFun _)
    (fromOpenSubsetsGlue_injective U) (fromOpenSubsetsGlue_isOpenMap U)
#align Top.glue_data.from_open_subsets_glue_open_embedding TopCat.GlueData.fromOpenSubsetsGlue_openEmbedding

theorem range_fromOpenSubsetsGlue : Set.range (fromOpenSubsetsGlue U) = ⋃ i, (U i : Set α) :=
  by
  ext
  constructor
  · rintro ⟨x, rfl⟩
    obtain ⟨i, ⟨x, hx'⟩, rfl⟩ := (of_open_subsets U).ι_jointly_surjective x
    rw [ι_from_open_subsets_glue_apply]
    exact Set.subset_unionᵢ _ i hx'
  · rintro ⟨_, ⟨i, rfl⟩, hx⟩
    refine' ⟨(of_open_subsets U).toGlueData.ι i ⟨x, hx⟩, ι_from_open_subsets_glue_apply _ _ _⟩
#align Top.glue_data.range_from_open_subsets_glue TopCat.GlueData.range_fromOpenSubsetsGlue

/-- The gluing of an open cover is homeomomorphic to the original space. -/
def openCoverGlueHomeo (h : (⋃ i, (U i : Set α)) = Set.univ) :
    (ofOpenSubsets U).toGlueData.glued ≃ₜ α :=
  Homeomorph.homeomorphOfContinuousOpen
    (Equiv.ofBijective (fromOpenSubsetsGlue U)
      ⟨fromOpenSubsetsGlue_injective U,
        Set.range_iff_surjective.mp ((range_fromOpenSubsetsGlue U).symm ▸ h)⟩)
    (fromOpenSubsetsGlue U).2 (fromOpenSubsetsGlue_isOpenMap U)
#align Top.glue_data.open_cover_glue_homeo TopCat.GlueData.openCoverGlueHomeo

end GlueData

end TopCat


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

! This file was ported from Lean 3 source module algebraic_geometry.morphisms.quasi_separated
! leanprover-community/mathlib commit d39590fc8728fbf6743249802486f8c91ffe07bc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicGeometry.Morphisms.QuasiCompact
import Mathbin.Topology.QuasiSeparated

/-!
# Quasi-separated morphisms

A morphism of schemes `f : X ⟶ Y` is quasi-separated if the diagonal morphism `X ⟶ X ×[Y] X` is
quasi-compact.

A scheme is quasi-separated if the intersections of any two affine open sets is quasi-compact.
(`algebraic_geometry.quasi_separated_space_iff_affine`)

We show that a morphism is quasi-separated if the preimage of every affine open is quasi-separated.

We also show that this property is local at the target,
and is stable under compositions and base-changes.

## Main result
- `is_localization_basic_open_of_qcqs` (**Qcqs lemma**):
  If `U` is qcqs, then `Γ(X, D(f)) ≃ Γ(X, U)_f` for every `f : Γ(X, U)`.

-/

noncomputable section

open CategoryTheory CategoryTheory.Limits Opposite TopologicalSpace

universe u

open AlgebraicGeometry

namespace AlgebraicGeometry

variable {X Y : Scheme.{u}} (f : X ⟶ Y)

/-- A morphism is `quasi_separated` if diagonal map is quasi-compact. -/
@[mk_iff]
class QuasiSeparated (f : X ⟶ Y) : Prop where
  diagonalQuasiCompact : QuasiCompact (pullback.diagonal f)
#align algebraic_geometry.quasi_separated AlgebraicGeometry.QuasiSeparated

/-- The `affine_target_morphism_property` corresponding to `quasi_separated`, asserting that the
domain is a quasi-separated scheme. -/
def QuasiSeparated.affineProperty : AffineTargetMorphismProperty := fun X Y f _ =>
  QuasiSeparatedSpace X.carrier
#align algebraic_geometry.quasi_separated.affine_property AlgebraicGeometry.QuasiSeparated.affineProperty

theorem quasiSeparatedSpace_iff_affine (X : Scheme) :
    QuasiSeparatedSpace X.carrier ↔ ∀ U V : X.affineOpens, IsCompact (U ∩ V : Set X.carrier) :=
  by
  rw [quasiSeparatedSpace_iff]
  constructor
  · intro H U V
    exact H U V U.1.2 U.2.IsCompact V.1.2 V.2.IsCompact
  · intro H
    suffices
      ∀ (U : opens X.carrier) (hU : IsCompact U.1) (V : opens X.carrier) (hV : IsCompact V.1),
        IsCompact (U ⊓ V).1
      by
      intro U V hU hU' hV hV'
      exact this ⟨U, hU⟩ hU' ⟨V, hV⟩ hV'
    intro U hU V hV
    apply compact_open_induction_on V hV
    · simp
    · intro S hS V hV
      change IsCompact (U.1 ∩ (S.1 ∪ V.1))
      rw [Set.inter_union_distrib_left]
      apply hV.union
      clear hV
      apply compact_open_induction_on U hU
      · simp
      · intro S hS W hW
        change IsCompact ((S.1 ∪ W.1) ∩ V.1)
        rw [Set.union_inter_distrib_right]
        apply hW.union
        apply H
#align algebraic_geometry.quasi_separated_space_iff_affine AlgebraicGeometry.quasiSeparatedSpace_iff_affine

theorem quasi_compact_affineProperty_iff_quasiSeparatedSpace {X Y : Scheme} [IsAffine Y]
    (f : X ⟶ Y) : QuasiCompact.affineProperty.diagonal f ↔ QuasiSeparatedSpace X.carrier :=
  by
  delta affine_target_morphism_property.diagonal
  rw [quasi_separated_space_iff_affine]
  constructor
  · intro H U V
    haveI : is_affine _ := U.2
    haveI : is_affine _ := V.2
    let g : pullback (X.of_restrict U.1.OpenEmbedding) (X.of_restrict V.1.OpenEmbedding) ⟶ X :=
      pullback.fst ≫ X.of_restrict _
    have : is_open_immersion g := inferInstance
    have e := Homeomorph.ofEmbedding _ this.base_open.to_embedding
    rw [is_open_immersion.range_pullback_to_base_of_left] at e
    erw [Subtype.range_coe, Subtype.range_coe] at e
    rw [isCompact_iff_compactSpace]
    exact @Homeomorph.compactSpace _ _ (H _ _) e
  · introv H h₁ h₂
    skip
    let g : pullback f₁ f₂ ⟶ X := pullback.fst ≫ f₁
    have : is_open_immersion g := inferInstance
    have e := Homeomorph.ofEmbedding _ this.base_open.to_embedding
    rw [is_open_immersion.range_pullback_to_base_of_left] at e
    simp_rw [isCompact_iff_compactSpace] at H
    exact
      @Homeomorph.compactSpace _ _
        (H ⟨⟨_, h₁.base_open.open_range⟩, range_is_affine_open_of_open_immersion _⟩
          ⟨⟨_, h₂.base_open.open_range⟩, range_is_affine_open_of_open_immersion _⟩)
        e.symm
#align algebraic_geometry.quasi_compact_affine_property_iff_quasi_separated_space AlgebraicGeometry.quasi_compact_affineProperty_iff_quasiSeparatedSpace

theorem quasiSeparated_eq_diagonal_is_quasiCompact :
    @QuasiSeparated = MorphismProperty.diagonal @QuasiCompact :=
  by
  ext
  exact quasi_separated_iff _
#align algebraic_geometry.quasi_separated_eq_diagonal_is_quasi_compact AlgebraicGeometry.quasiSeparated_eq_diagonal_is_quasiCompact

theorem quasi_compact_affineProperty_diagonal_eq :
    QuasiCompact.affineProperty.diagonal = QuasiSeparated.affineProperty :=
  by
  ext
  rw [quasi_compact_affine_property_iff_quasi_separated_space]
  rfl
#align algebraic_geometry.quasi_compact_affine_property_diagonal_eq AlgebraicGeometry.quasi_compact_affineProperty_diagonal_eq

theorem quasiSeparated_eq_affineProperty_diagonal :
    @QuasiSeparated = targetAffineLocally QuasiCompact.affineProperty.diagonal :=
  by
  rw [quasi_separated_eq_diagonal_is_quasi_compact, quasi_compact_eq_affine_property]
  exact
    diagonal_target_affine_locally_eq_target_affine_locally _ quasi_compact.affine_property_is_local
#align algebraic_geometry.quasi_separated_eq_affine_property_diagonal AlgebraicGeometry.quasiSeparated_eq_affineProperty_diagonal

theorem quasiSeparated_eq_affineProperty :
    @QuasiSeparated = targetAffineLocally QuasiSeparated.affineProperty := by
  rw [quasi_separated_eq_affine_property_diagonal, quasi_compact_affine_property_diagonal_eq]
#align algebraic_geometry.quasi_separated_eq_affine_property AlgebraicGeometry.quasiSeparated_eq_affineProperty

theorem QuasiSeparated.affinePropertyIsLocal : QuasiSeparated.affineProperty.IsLocal :=
  quasi_compact_affineProperty_diagonal_eq ▸ QuasiCompact.affinePropertyIsLocal.diagonal
#align algebraic_geometry.quasi_separated.affine_property_is_local AlgebraicGeometry.QuasiSeparated.affinePropertyIsLocal

instance (priority := 900) quasiSeparatedOfMono {X Y : Scheme} (f : X ⟶ Y) [Mono f] :
    QuasiSeparated f :=
  ⟨inferInstance⟩
#align algebraic_geometry.quasi_separated_of_mono AlgebraicGeometry.quasiSeparatedOfMono

theorem quasiSeparated_stableUnderComposition :
    MorphismProperty.StableUnderComposition @QuasiSeparated :=
  quasiSeparated_eq_diagonal_is_quasiCompact.symm ▸
    quasiCompact_stableUnderComposition.diagonal quasiCompact_respectsIso
      quasiCompact_stableUnderBaseChange
#align algebraic_geometry.quasi_separated_stable_under_composition AlgebraicGeometry.quasiSeparated_stableUnderComposition

theorem quasiSeparated_stableUnderBaseChange :
    MorphismProperty.StableUnderBaseChange @QuasiSeparated :=
  quasiSeparated_eq_diagonal_is_quasiCompact.symm ▸
    quasiCompact_stableUnderBaseChange.diagonal quasiCompact_respectsIso
#align algebraic_geometry.quasi_separated_stable_under_base_change AlgebraicGeometry.quasiSeparated_stableUnderBaseChange

instance quasiSeparatedComp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) [QuasiSeparated f]
    [QuasiSeparated g] : QuasiSeparated (f ≫ g) :=
  quasiSeparated_stableUnderComposition f g inferInstance inferInstance
#align algebraic_geometry.quasi_separated_comp AlgebraicGeometry.quasiSeparatedComp

theorem quasiSeparated_respectsIso : MorphismProperty.RespectsIso @QuasiSeparated :=
  quasiSeparated_eq_diagonal_is_quasiCompact.symm ▸ quasiCompact_respectsIso.diagonal
#align algebraic_geometry.quasi_separated_respects_iso AlgebraicGeometry.quasiSeparated_respectsIso

theorem QuasiSeparated.affine_openCover_tFAE {X Y : Scheme.{u}} (f : X ⟶ Y) :
    TFAE
      [QuasiSeparated f,
        ∃ (𝒰 : Scheme.OpenCover.{u} Y)(_ : ∀ i, IsAffine (𝒰.obj i)),
          ∀ i : 𝒰.J, QuasiSeparatedSpace (pullback f (𝒰.map i)).carrier,
        ∀ (𝒰 : Scheme.OpenCover.{u} Y) [∀ i, IsAffine (𝒰.obj i)] (i : 𝒰.J),
          QuasiSeparatedSpace (pullback f (𝒰.map i)).carrier,
        ∀ {U : Scheme} (g : U ⟶ Y) [IsAffine U] [IsOpenImmersion g],
          QuasiSeparatedSpace (pullback f g).carrier,
        ∃ (𝒰 : Scheme.OpenCover.{u} Y)(_ : ∀ i, IsAffine (𝒰.obj i))(𝒰' :
          ∀ i : 𝒰.J, Scheme.OpenCover.{u} (pullback f (𝒰.map i)))(_ :
          ∀ i j, IsAffine ((𝒰' i).obj j)),
          ∀ (i : 𝒰.J) (j k : (𝒰' i).J),
            CompactSpace (pullback ((𝒰' i).map j) ((𝒰' i).map k)).carrier] :=
  by
  have := quasi_compact.affine_property_is_local.diagonal_affine_open_cover_tfae f
  simp_rw [← quasi_compact_eq_affine_property, ← quasi_separated_eq_diagonal_is_quasi_compact,
    quasi_compact_affine_property_diagonal_eq] at this
  exact this
#align algebraic_geometry.quasi_separated.affine_open_cover_tfae AlgebraicGeometry.QuasiSeparated.affine_openCover_tFAE

theorem QuasiSeparated.isLocalAtTarget : PropertyIsLocalAtTarget @QuasiSeparated :=
  quasiSeparated_eq_affineProperty_diagonal.symm ▸
    QuasiCompact.affinePropertyIsLocal.diagonal.targetAffineLocallyIsLocal
#align algebraic_geometry.quasi_separated.is_local_at_target AlgebraicGeometry.QuasiSeparated.isLocalAtTarget

theorem QuasiSeparated.openCover_tFAE {X Y : Scheme.{u}} (f : X ⟶ Y) :
    TFAE
      [QuasiSeparated f,
        ∃ 𝒰 : Scheme.OpenCover.{u} Y,
          ∀ i : 𝒰.J, QuasiSeparated (pullback.snd : (𝒰.pullbackCover f).obj i ⟶ 𝒰.obj i),
        ∀ (𝒰 : Scheme.OpenCover.{u} Y) (i : 𝒰.J),
          QuasiSeparated (pullback.snd : (𝒰.pullbackCover f).obj i ⟶ 𝒰.obj i),
        ∀ U : Opens Y.carrier, QuasiSeparated (f ∣_ U),
        ∀ {U : Scheme} (g : U ⟶ Y) [IsOpenImmersion g],
          QuasiSeparated (pullback.snd : pullback f g ⟶ _),
        ∃ (ι : Type u)(U : ι → Opens Y.carrier)(hU : supᵢ U = ⊤), ∀ i, QuasiSeparated (f ∣_ U i)] :=
  QuasiSeparated.isLocalAtTarget.openCover_tFAE f
#align algebraic_geometry.quasi_separated.open_cover_tfae AlgebraicGeometry.QuasiSeparated.openCover_tFAE

theorem quasiSeparated_over_affine_iff {X Y : Scheme} (f : X ⟶ Y) [IsAffine Y] :
    QuasiSeparated f ↔ QuasiSeparatedSpace X.carrier := by
  rw [quasi_separated_eq_affine_property,
    quasi_separated.affine_property_is_local.affine_target_iff f, quasi_separated.affine_property]
#align algebraic_geometry.quasi_separated_over_affine_iff AlgebraicGeometry.quasiSeparated_over_affine_iff

theorem quasiSeparatedSpace_iff_quasiSeparated (X : Scheme) :
    QuasiSeparatedSpace X.carrier ↔ QuasiSeparated (terminal.from X) :=
  (quasiSeparated_over_affine_iff _).symm
#align algebraic_geometry.quasi_separated_space_iff_quasi_separated AlgebraicGeometry.quasiSeparatedSpace_iff_quasiSeparated

theorem QuasiSeparated.affine_openCover_iff {X Y : Scheme.{u}} (𝒰 : Scheme.OpenCover.{u} Y)
    [∀ i, IsAffine (𝒰.obj i)] (f : X ⟶ Y) :
    QuasiSeparated f ↔ ∀ i, QuasiSeparatedSpace (pullback f (𝒰.map i)).carrier :=
  by
  rw [quasi_separated_eq_affine_property,
    quasi_separated.affine_property_is_local.affine_open_cover_iff f 𝒰]
  rfl
#align algebraic_geometry.quasi_separated.affine_open_cover_iff AlgebraicGeometry.QuasiSeparated.affine_openCover_iff

theorem QuasiSeparated.openCover_iff {X Y : Scheme.{u}} (𝒰 : Scheme.OpenCover.{u} Y) (f : X ⟶ Y) :
    QuasiSeparated f ↔ ∀ i, QuasiSeparated (pullback.snd : pullback f (𝒰.map i) ⟶ _) :=
  QuasiSeparated.isLocalAtTarget.openCover_iff f 𝒰
#align algebraic_geometry.quasi_separated.open_cover_iff AlgebraicGeometry.QuasiSeparated.openCover_iff

instance {X Y S : Scheme} (f : X ⟶ S) (g : Y ⟶ S) [QuasiSeparated g] :
    QuasiSeparated (pullback.fst : pullback f g ⟶ X) :=
  quasiSeparated_stableUnderBaseChange.fst f g inferInstance

instance {X Y S : Scheme} (f : X ⟶ S) (g : Y ⟶ S) [QuasiSeparated f] :
    QuasiSeparated (pullback.snd : pullback f g ⟶ Y) :=
  quasiSeparated_stableUnderBaseChange.snd f g inferInstance

instance {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) [QuasiSeparated f] [QuasiSeparated g] :
    QuasiSeparated (f ≫ g) :=
  quasiSeparated_stableUnderComposition f g inferInstance inferInstance

theorem quasiSeparatedSpace_of_quasiSeparated {X Y : Scheme} (f : X ⟶ Y)
    [hY : QuasiSeparatedSpace Y.carrier] [QuasiSeparated f] : QuasiSeparatedSpace X.carrier :=
  by
  rw [quasi_separated_space_iff_quasi_separated] at hY⊢
  have : f ≫ terminal.from Y = terminal.from X := terminal_is_terminal.hom_ext _ _
  rw [← this]
  skip; infer_instance
#align algebraic_geometry.quasi_separated_space_of_quasi_separated AlgebraicGeometry.quasiSeparatedSpace_of_quasiSeparated

instance quasiSeparatedSpace_of_isAffine (X : Scheme) [IsAffine X] :
    QuasiSeparatedSpace X.carrier := by
  constructor
  intro U V hU hU' hV hV'
  obtain ⟨s, hs, e⟩ := (is_compact_open_iff_eq_basic_open_union _).mp ⟨hU', hU⟩
  obtain ⟨s', hs', e'⟩ := (is_compact_open_iff_eq_basic_open_union _).mp ⟨hV', hV⟩
  rw [e, e', Set.unionᵢ₂_inter]
  simp_rw [Set.inter_unionᵢ₂]
  apply hs.is_compact_bUnion
  · intro i hi
    apply hs'.is_compact_bUnion
    intro i' hi'
    change IsCompact (X.basic_open i ⊓ X.basic_open i').1
    rw [← Scheme.basic_open_mul]
    exact ((top_is_affine_open _).basicOpen_is_affine _).IsCompact
#align algebraic_geometry.quasi_separated_space_of_is_affine AlgebraicGeometry.quasiSeparatedSpace_of_isAffine

theorem IsAffineOpen.isQuasiSeparated {X : Scheme} {U : Opens X.carrier} (hU : IsAffineOpen U) :
    IsQuasiSeparated (U : Set X.carrier) :=
  by
  rw [isQuasiSeparated_iff_quasiSeparatedSpace]
  exacts[@AlgebraicGeometry.quasiSeparatedSpace_of_isAffine _ hU, U.is_open]
#align algebraic_geometry.is_affine_open.is_quasi_separated AlgebraicGeometry.IsAffineOpen.isQuasiSeparated

theorem quasiSeparatedOfComp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) [H : QuasiSeparated (f ≫ g)] :
    QuasiSeparated f :=
  by
  rw [(quasi_separated.affine_open_cover_tfae f).out 0 1]
  rw [(quasi_separated.affine_open_cover_tfae (f ≫ g)).out 0 2] at H
  use (Z.affine_cover.pullback_cover g).bind fun x => Scheme.affine_cover _
  constructor;
  · intro i
    dsimp
    infer_instance
  rintro ⟨i, j⟩; dsimp at *
  specialize H _ i
  refine' @quasi_separated_space_of_quasi_separated _ H _
  ·
    exact
      pullback.map _ _ _ _ (𝟙 _) _ _ (by simp) (category.comp_id _) ≫
        (pullback_right_pullback_fst_iso g (Z.affine_cover.map i) f).Hom
  · apply AlgebraicGeometry.quasiSeparatedOfMono
#align algebraic_geometry.quasi_separated_of_comp AlgebraicGeometry.quasiSeparatedOfComp

theorem exists_eq_pow_mul_of_isAffineOpen (X : Scheme) (U : Opens X.carrier) (hU : IsAffineOpen U)
    (f : X.Presheaf.obj (op U)) (x : X.Presheaf.obj (op <| X.basicOpen f)) :
    ∃ (n : ℕ)(y : X.Presheaf.obj (op U)), y |_ X.basicOpen f = (f |_ X.basicOpen f) ^ n * x :=
  by
  have := (is_localization_basic_open hU f).2
  obtain ⟨⟨y, _, n, rfl⟩, d⟩ := this x
  use n, y
  delta TopCat.Presheaf.restrictOpen TopCat.Presheaf.restrict
  simpa [mul_comm x] using d.symm
#align algebraic_geometry.exists_eq_pow_mul_of_is_affine_open AlgebraicGeometry.exists_eq_pow_mul_of_isAffineOpen

theorem exists_eq_pow_mul_of_is_compact_of_quasi_separated_space_aux (X : Scheme)
    (S : X.affineOpens) (U₁ U₂ : Opens X.carrier) {n₁ n₂ : ℕ} {y₁ : X.Presheaf.obj (op U₁)}
    {y₂ : X.Presheaf.obj (op U₂)} {f : X.Presheaf.obj (op <| U₁ ⊔ U₂)}
    {x : X.Presheaf.obj (op <| X.basicOpen f)} (h₁ : S.1 ≤ U₁) (h₂ : S.1 ≤ U₂)
    (e₁ :
      X.Presheaf.map
          (homOfLE <| X.basicOpen_le (X.Presheaf.map (homOfLE le_sup_left).op f) : _ ⟶ U₁).op y₁ =
        X.Presheaf.map
              (homOfLE
                  (by
                    erw [X.basic_open_res]
                    exact inf_le_left)).op
              (X.Presheaf.map (homOfLE le_sup_left).op f) ^
            n₁ *
          (X.Presheaf.map
              (homOfLE
                  (by
                    erw [X.basic_open_res]
                    exact inf_le_right)).op)
            x)
    (e₂ :
      X.Presheaf.map
          (homOfLE <| X.basicOpen_le (X.Presheaf.map (homOfLE le_sup_right).op f) : _ ⟶ U₂).op y₂ =
        X.Presheaf.map
              (homOfLE
                  (by
                    rw [X.basic_open_res]
                    exact inf_le_left)).op
              (X.Presheaf.map (homOfLE le_sup_right).op f) ^
            n₂ *
          (X.Presheaf.map
              (homOfLE
                  (by
                    rw [X.basic_open_res]
                    exact inf_le_right)).op)
            x) :
    ∃ n : ℕ,
      X.Presheaf.map (homOfLE <| h₁).op
          (X.Presheaf.map (homOfLE le_sup_left).op f ^ (n + n₂) * y₁) =
        X.Presheaf.map (homOfLE <| h₂).op
          (X.Presheaf.map (homOfLE le_sup_right).op f ^ (n + n₁) * y₂) :=
  by
  have :=
    is_localization_basic_open S.2 (X.presheaf.map (hom_of_le <| le_trans h₁ le_sup_left).op f)
  obtain ⟨⟨_, n, rfl⟩, e⟩ :=
    (@IsLocalization.eq_iff_exists _ _ _ _ _ _ this
          (X.presheaf.map (hom_of_le <| h₁).op
            (X.presheaf.map (hom_of_le le_sup_left).op f ^ n₂ * y₁))
          (X.presheaf.map (hom_of_le <| h₂).op
            (X.presheaf.map (hom_of_le le_sup_right).op f ^ n₁ * y₂))).mp
      _
  swap
  · simp only [map_pow, RingHom.algebraMap_toAlgebra, map_mul, ← comp_apply, ← functor.map_comp, ←
      op_comp, hom_of_le_comp]
    have h₃ : X.basic_open ((X.presheaf.map (hom_of_le (h₁.trans le_sup_left)).op) f) ≤ S.val := by
      simpa only [X.basic_open_res] using inf_le_left
    trans
      X.presheaf.map (hom_of_le <| h₃.trans <| h₁.trans le_sup_left).op f ^ (n₂ + n₁) *
        X.presheaf.map (hom_of_le <| (X.basic_open_res f _).trans_le inf_le_right).op x
    · rw [pow_add, mul_assoc]
      congr 1
      convert congr_arg (X.presheaf.map (hom_of_le _).op) e₁
      · simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp]
        congr
      · simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp]
        congr
      · rw [X.basic_open_res, X.basic_open_res]
        rintro x ⟨H₁, H₂⟩
        exact ⟨h₁ H₁, H₂⟩
    · rw [add_comm, pow_add, mul_assoc]
      congr 1
      convert congr_arg (X.presheaf.map (hom_of_le _).op) e₂.symm
      · simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp]
        congr
      · simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp]
        congr
      · simp only [X.basic_open_res]
        rintro x ⟨H₁, H₂⟩
        exact ⟨h₂ H₁, H₂⟩
  use n
  simp only [pow_add, map_pow, map_mul, ← comp_apply, ← mul_assoc, ← functor.map_comp,
    Subtype.coe_mk] at e⊢
  exact e
#align algebraic_geometry.exists_eq_pow_mul_of_is_compact_of_quasi_separated_space_aux AlgebraicGeometry.exists_eq_pow_mul_of_is_compact_of_quasi_separated_space_aux

theorem exists_eq_pow_mul_of_isCompact_of_isQuasiSeparated (X : Scheme) (U : Opens X.carrier)
    (hU : IsCompact U.1) (hU' : IsQuasiSeparated U.1) (f : X.Presheaf.obj (op U))
    (x : X.Presheaf.obj (op <| X.basicOpen f)) :
    ∃ (n : ℕ)(y : X.Presheaf.obj (op U)), y |_ X.basicOpen f = (f |_ X.basicOpen f) ^ n * x :=
  by
  delta TopCat.Presheaf.restrictOpen TopCat.Presheaf.restrict
  revert hU' f x
  apply compact_open_induction_on U hU
  · intro hU' f x
    use 0, f
    refine'
      @Subsingleton.elim
        (CommRingCat.subsingleton_of_isTerminal (X.sheaf.is_terminal_of_eq_empty _)) _ _
    erw [eq_bot_iff]
    exact X.basic_open_le f
  · -- Given `f : 𝒪(S ∪ U), x : 𝒪(X_f)`, we need to show that `f ^ n * x` is the restriction of
    -- some `y : 𝒪(S ∪ U)` for some `n : ℕ`.
    intro S hS U hU hSU f x
    -- We know that such `y₁, n₁` exists on `S` by the induction hypothesis.
    obtain ⟨n₁, y₁, hy₁⟩ :=
      hU (hSU.of_subset <| Set.subset_union_left _ _) (X.presheaf.map (hom_of_le le_sup_left).op f)
        (X.presheaf.map (hom_of_le _).op x)
    swap
    · rw [X.basic_open_res]
      exact inf_le_right
    -- We know that such `y₂, n₂` exists on `U` since `U` is affine.
    obtain ⟨n₂, y₂, hy₂⟩ :=
      exists_eq_pow_mul_of_is_affine_open X _ U.2 (X.presheaf.map (hom_of_le le_sup_right).op f)
        (X.presheaf.map (hom_of_le _).op x)
    delta TopCat.Presheaf.restrictOpen TopCat.Presheaf.restrict at hy₂
    swap
    · rw [X.basic_open_res]
      exact inf_le_right
    -- Since `S ∪ U` is quasi-separated, `S ∩ U` can be covered by finite affine opens.
    obtain ⟨s, hs', hs⟩ :=
      (is_compact_open_iff_eq_finset_affine_union _).mp
        ⟨hSU _ _ (Set.subset_union_left _ _) S.2 hS (Set.subset_union_right _ _) U.1.2
            U.2.IsCompact,
          (S ⊓ U.1).2⟩
    haveI := hs'.to_subtype
    cases nonempty_fintype s
    replace hs : S ⊓ U.1 = supᵢ fun i : s => (i : opens X.carrier) :=
      by
      ext1
      simpa using hs
    have hs₁ : ∀ i : s, i.1.1 ≤ S := by
      intro i
      change (i : opens X.carrier) ≤ S
      refine' le_trans _ inf_le_left
      use U.1
      erw [hs]
      exact le_supᵢ _ _
    have hs₂ : ∀ i : s, i.1.1 ≤ U.1 := by
      intro i
      change (i : opens X.carrier) ≤ U
      refine' le_trans _ inf_le_right
      use S
      erw [hs]
      exact le_supᵢ _ _
    -- On each affine open in the intersection, we have `f ^ (n + n₂) * y₁ = f ^ (n + n₁) * y₂`
    -- for some `n` since `f ^ n₂ * y₁ = f ^ (n₁ + n₂) * x = f ^ n₁ * y₂` on `X_f`.
    have :
      ∀ i : s,
        ∃ n : ℕ,
          X.presheaf.map (hom_of_le <| hs₁ i).op
              (X.presheaf.map (hom_of_le le_sup_left).op f ^ (n + n₂) * y₁) =
            X.presheaf.map (hom_of_le <| hs₂ i).op
              (X.presheaf.map (hom_of_le le_sup_right).op f ^ (n + n₁) * y₂) :=
      by
      intro i
      exact
        exists_eq_pow_mul_of_is_compact_of_quasi_separated_space_aux X i.1 S U (hs₁ i) (hs₂ i) hy₁
          hy₂
    choose n hn using this
    -- We can thus choose a big enough `n` such that `f ^ (n + n₂) * y₁ = f ^ (n + n₁) * y₂`
    -- on `S ∩ U`.
    have :
      X.presheaf.map (hom_of_le <| inf_le_left).op
          (X.presheaf.map (hom_of_le le_sup_left).op f ^ (finset.univ.sup n + n₂) * y₁) =
        X.presheaf.map (hom_of_le <| inf_le_right).op
          (X.presheaf.map (hom_of_le le_sup_right).op f ^ (finset.univ.sup n + n₁) * y₂) :=
      by
      fapply X.sheaf.eq_of_locally_eq' fun i : s => i.1.1
      · refine' fun i => hom_of_le _
        erw [hs]
        exact le_supᵢ _ _
      · exact le_of_eq hs
      · intro i
        replace hn :=
          congr_arg
            (fun x =>
              X.presheaf.map (hom_of_le (le_trans (hs₁ i) le_sup_left)).op f ^
                  (finset.univ.sup n - n i) *
                x)
            (hn i)
        dsimp only at hn
        delta Scheme.sheaf SheafedSpace.sheaf
        simp only [← map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp, ← mul_assoc] at
          hn⊢
        erw [← map_mul, ← map_mul] at hn
        rw [← pow_add, ← pow_add, ← add_assoc, ← add_assoc, tsub_add_cancel_of_le] at hn
        convert hn
        exact Finset.le_sup (Finset.mem_univ _)
    use finset.univ.sup n + n₁ + n₂
    -- By the sheaf condition, since `f ^ (n + n₂) * y₁ = f ^ (n + n₁) * y₂`, it can be glued into
    -- the desired section on `S ∪ U`.
    use (X.sheaf.obj_sup_iso_prod_eq_locus S U.1).inv ⟨⟨_ * _, _ * _⟩, this⟩
    refine'
      X.sheaf.eq_of_locally_eq₂
        (hom_of_le (_ : X.basic_open (X.presheaf.map (hom_of_le le_sup_left).op f) ≤ _))
        (hom_of_le (_ : X.basic_open (X.presheaf.map (hom_of_le le_sup_right).op f) ≤ _)) _ _ _ _ _
    · rw [X.basic_open_res]
      exact inf_le_right
    · rw [X.basic_open_res]
      exact inf_le_right
    · rw [X.basic_open_res, X.basic_open_res]
      erw [← inf_sup_right]
      refine' le_inf_iff.mpr ⟨X.basic_open_le f, le_of_eq rfl⟩
    · convert congr_arg (X.presheaf.map (hom_of_le _).op)
          (X.sheaf.obj_sup_iso_prod_eq_locus_inv_fst S U.1 ⟨⟨_ * _, _ * _⟩, this⟩) using 1
      · delta Scheme.sheaf SheafedSpace.sheaf
        simp only [← comp_apply (X.presheaf.map _) (X.presheaf.map _), ← functor.map_comp, ←
          op_comp]
        congr
      · delta Scheme.sheaf SheafedSpace.sheaf
        simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp, mul_assoc,
          pow_add]
        erw [hy₁]
        congr 1
        rw [← mul_assoc, ← mul_assoc]
        congr 1
        rw [mul_comm, ← comp_apply, ← functor.map_comp]
        congr
    · convert congr_arg (X.presheaf.map (hom_of_le _).op)
          (X.sheaf.obj_sup_iso_prod_eq_locus_inv_snd S U.1 ⟨⟨_ * _, _ * _⟩, this⟩) using 1
      · delta Scheme.sheaf SheafedSpace.sheaf
        simp only [← comp_apply (X.presheaf.map _) (X.presheaf.map _), ← functor.map_comp, ←
          op_comp]
        congr
      · delta Scheme.sheaf SheafedSpace.sheaf
        simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp, mul_assoc,
          pow_add]
        erw [hy₂]
        rw [← comp_apply, ← functor.map_comp]
        congr
#align algebraic_geometry.exists_eq_pow_mul_of_is_compact_of_is_quasi_separated AlgebraicGeometry.exists_eq_pow_mul_of_isCompact_of_isQuasiSeparated

/-- If `U` is qcqs, then `Γ(X, D(f)) ≃ Γ(X, U)_f` for every `f : Γ(X, U)`.
This is known as the **Qcqs lemma** in [R. Vakil, *The rising sea*][RisingSea]. -/
theorem is_localization_basicOpen_of_qcqs {X : Scheme} {U : Opens X.carrier} (hU : IsCompact U.1)
    (hU' : IsQuasiSeparated U.1) (f : X.Presheaf.obj (op U)) :
    IsLocalization.Away f (X.Presheaf.obj (op <| X.basicOpen f)) :=
  by
  constructor
  · rintro ⟨_, n, rfl⟩
    simp only [map_pow, Subtype.coe_mk, RingHom.algebraMap_toAlgebra]
    exact IsUnit.pow _ (RingedSpace.is_unit_res_basic_open _ f)
  · intro z
    obtain ⟨n, y, e⟩ := exists_eq_pow_mul_of_is_compact_of_is_quasi_separated X U hU hU' f z
    refine' ⟨⟨y, _, n, rfl⟩, _⟩
    simpa only [map_pow, Subtype.coe_mk, RingHom.algebraMap_toAlgebra, mul_comm z] using e.symm
  · intro x y
    rw [← sub_eq_zero, ← map_sub, RingHom.algebraMap_toAlgebra]
    simp_rw [← @sub_eq_zero _ _ (_ * x) (_ * y), ← mul_sub]
    generalize x - y = z
    constructor
    · intro H
      obtain ⟨n, e⟩ := exists_pow_mul_eq_zero_of_res_basic_open_eq_zero_of_is_compact X hU _ _ H
      refine' ⟨⟨_, n, rfl⟩, _⟩
      simpa [mul_comm z] using e
    · rintro ⟨⟨_, n, rfl⟩, e : f ^ n * z = 0⟩
      rw [← ((RingedSpace.is_unit_res_basic_open _ f).pow n).mul_right_inj, MulZeroClass.mul_zero, ←
        map_pow, ← map_mul, e, map_zero]
#align algebraic_geometry.is_localization_basic_open_of_qcqs AlgebraicGeometry.is_localization_basicOpen_of_qcqs

end AlgebraicGeometry


import tactic -- hide
open function -- hide
/-
## Functions

Here we introduce the definition of a function being surjective,
and prove a "dual" version to the lemma from the previous level.
-/

variables {X Y Z : Type} {x : X} (f : X → Y) (g : Y → Z) -- hide

lemma surjective_def : surjective f ↔ ∀ y, ∃ x, f x = y
:= iff.rfl -- hide

/- Lemma : no-side-bar
If $g \circ f$ is surjective, then $g$ is surjective.
-/
lemma surjective_comp :
surjective (g ∘ f) → surjective g :=
begin
  intro h,
  rw surjective_def at h ⊢,
  intro b,
  specialize h b,
  cases h with x hx,
  use f x,
  assumption,

end