/-
Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Pierre-Alexandre Bazin, Scott Morrison
-/
import category_theory.simple
import algebra.category.Module.abelian
import algebra.category.Module.subobject
import ring_theory.simple_module

/-!
# Simple objects in the category of `R`-modules

We prove simple modules are exactly simple objects in the category of `R`-modules.
-/

variables {R M : Type*} [ring R] [add_comm_group M] [module R M]
open category_theory Module

lemma simple_iff_is_simple_module : simple (of R M) ↔ is_simple_module R M :=
(simple_iff_subobject_is_simple_order _).trans (subobject_Module (of R M)).is_simple_order_iff

/-- A simple module is a simple object in the category of modules. -/
instance simple_of_is_simple_module [is_simple_module R M] : simple (of R M) :=
simple_iff_is_simple_module.mpr ‹_›

/-- A simple object in the category of modules is a simple module. -/
instance is_simple_module_of_simple (M : Module R) [simple M] : is_simple_module R M :=
simple_iff_is_simple_module.mp (simple.of_iso (of_self_iso M))


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

universes u v

open nat function
variables {α : Type u} {β : Type v}

namespace list

/- sections -/

theorem mem_sections {L : list (list α)} {f} : f ∈ sections L ↔ forall₂ (∈) f L :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { induction L generalizing f, {cases mem_singleton.1 h, exact forall₂.nil},
    simp only [sections, bind_eq_bind, mem_bind, mem_map] at h,
    rcases h with ⟨_, _, _, _, rfl⟩,
    simp only [*, forall₂_cons, true_and] },
  { induction h with a l f L al fL fs, {exact or.inl rfl},
    simp only [sections, bind_eq_bind, mem_bind, mem_map],
    exact ⟨_, fs, _, al, rfl, rfl⟩ }
end

lemma rel_sections {r : α → β → Prop} :
  (forall₂ (forall₂ r) ⇒ forall₂ (forall₂ r)) sections sections
| _ _ forall₂.nil := forall₂.cons forall₂.nil forall₂.nil
| _ _ (forall₂.cons h₀ h₁) :=
  rel_bind (rel_sections h₁) (assume _ _ hl, rel_map (assume _ _ ha, forall₂.cons ha hl) h₀)

end list


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

A data type for semiquotients, which are classically equivalent to
nonempty sets, but are useful for programming; the idea is that
a semiquotient set `S` represents some (particular but unknown)
element of `S`. This can be used to model nondeterministic functions,
which return something in a range of values (represented by the
predicate `S`) but are not completely determined.
-/
import data.set.lattice data.quot

/-- A member of `semiquot α` is classically a nonempty `set α`,
  and in the VM is represented by an element of `α`; the relation
  between these is that the VM element is required to be a member
  of the set `s`. The specific element of `s` that the VM computes
  is hidden by a quotient construction, allowing for the representation
  of nondeterministic functions. -/
structure {u} semiquot (α : Type*) := mk' ::
(s : set α)
(val : trunc ↥s)

namespace semiquot
variables {α : Type*} {β : Type*}

instance : has_mem α (semiquot α) := ⟨λ a q, a ∈ q.s⟩

def mk {a : α} {s : set α} (h : a ∈ s) : semiquot α :=
⟨s, trunc.mk ⟨a, h⟩⟩

theorem ext_s {q₁ q₂ : semiquot α} : q₁ = q₂ ↔ q₁.s = q₂.s :=
⟨congr_arg _,
 λ h, by cases q₁; cases q₂; congr; exact h⟩

theorem ext {q₁ q₂ : semiquot α} : q₁ = q₂ ↔ ∀ a, a ∈ q₁ ↔ a ∈ q₂ :=
ext_s.trans (set.ext_iff _ _)

theorem exists_mem (q : semiquot α) : ∃ a, a ∈ q :=
let ⟨⟨a, h⟩, h₂⟩ := q.2.exists_rep in ⟨a, h⟩

theorem eq_mk_of_mem {q : semiquot α} {a : α} (h : a ∈ q) :
  q = @mk _ a q.1 h := ext_s.2 rfl

theorem ne_empty (q : semiquot α) : q.s ≠ ∅ :=
let ⟨a, h⟩ := q.exists_mem in set.ne_empty_of_mem h

protected def pure (a : α) : semiquot α := mk (set.mem_singleton a)

@[simp] theorem mem_pure' {a b : α} : a ∈ semiquot.pure b ↔ a = b :=
set.mem_singleton_iff

def blur' (q : semiquot α) {s : set α} (h : q.s ⊆ s) : semiquot α :=
⟨s, trunc.lift (λ a : q.s, trunc.mk ⟨a.1, h a.2⟩)
  (λ _ _, trunc.eq _ _) q.2⟩

def blur (s : set α) (q : semiquot α) : semiquot α :=
blur' q (set.subset_union_right s q.s)

theorem blur_eq_blur' (q : semiquot α) (s : set α) (h : q.s ⊆ s) :
  blur s q = blur' q h :=
by unfold blur; congr; exact set.union_eq_self_of_subset_right h

@[simp] theorem mem_blur' (q : semiquot α) {s : set α} (h : q.s ⊆ s)
  {a : α} : a ∈ blur' q h ↔ a ∈ s := iff.rfl

def of_trunc (q : trunc α) : semiquot α :=
⟨set.univ, q.map (λ a, ⟨a, trivial⟩)⟩

def to_trunc (q : semiquot α) : trunc α :=
q.2.map subtype.val

def lift_on (q : semiquot α) (f : α → β) (h : ∀ a b ∈ q, f a = f b) : β :=
trunc.lift_on q.2 (λ x, f x.1) (λ x y, h _ _ x.2 y.2)

theorem lift_on_of_mem (q : semiquot α)
  (f : α → β) (h : ∀ a b ∈ q, f a = f b)
  (a : α) (aq : a ∈ q) : lift_on q f h = f a :=
by revert h; rw eq_mk_of_mem aq; intro; refl

def map (f : α → β) (q : semiquot α) : semiquot β :=
⟨f '' q.1, q.2.map (λ x, ⟨f x.1, set.mem_image_of_mem _ x.2⟩)⟩

@[simp] theorem mem_map (f : α → β) (q : semiquot α) (b : β) :
  b ∈ map f q ↔ ∃ a, a ∈ q ∧ f a = b := set.mem_image _ _ _

def bind (q : semiquot α) (f : α → semiquot β) : semiquot β :=
⟨⋃ a ∈ q.1, (f a).1,
 q.2.bind (λ a, (f a.1).2.map (λ b, ⟨b.1, set.mem_bUnion a.2 b.2⟩))⟩

@[simp] theorem mem_bind (q : semiquot α) (f : α → semiquot β) (b : β) :
  b ∈ bind q f ↔ ∃ a, a ∈ q ∧ b ∈ f a := set.mem_bUnion_iff

instance : monad semiquot :=
{ pure := @semiquot.pure,
  map := @semiquot.map,
  bind := @semiquot.bind }

@[simp] theorem mem_pure {a b : α} : a ∈ (pure b : semiquot α) ↔ a = b :=
set.mem_singleton_iff

theorem mem_pure_self (a : α) : a ∈ (pure a : semiquot α) :=
set.mem_singleton a

@[simp] theorem pure_inj {a b : α} : (pure a : semiquot α) = pure b ↔ a = b :=
ext_s.trans set.singleton_eq_singleton_iff

instance : is_lawful_monad semiquot :=
{ pure_bind  := λ α β x f, ext.2 $ by simp,
  bind_assoc := λ α β γ s f g, ext.2 $ by simp; exact
    λ c, ⟨λ ⟨b, ⟨a, as, bf⟩, cg⟩, ⟨a, as, b, bf, cg⟩,
          λ ⟨a, as, b, bf, cg⟩, ⟨b, ⟨a, as, bf⟩, cg⟩⟩,
  id_map     := λ α q, ext.2 $ by simp,
  bind_pure_comp_eq_map := λ α β f s, ext.2 $ by simp [eq_comm] }

instance : has_le (semiquot α) := ⟨λ s t, s.s ⊆ t.s⟩

instance : partial_order (semiquot α) :=
{ le := λ s t, ∀ ⦃x⦄, x ∈ s → x ∈ t,
  le_refl := λ s, set.subset.refl _,
  le_trans := λ s t u, set.subset.trans,
  le_antisymm := λ s t h₁ h₂, ext_s.2 (set.subset.antisymm h₁ h₂) }

instance : lattice.semilattice_sup (semiquot α) :=
{ sup := λ s, blur s.s,
  le_sup_left := λ s t, set.subset_union_left _ _,
  le_sup_right := λ s t, set.subset_union_right _ _,
  sup_le := λ s t u, set.union_subset,
  ..semiquot.partial_order }

@[simp] theorem pure_le {a : α} {s : semiquot α} : pure a ≤ s ↔ a ∈ s :=
set.singleton_subset_iff

def is_pure (q : semiquot α) := ∀ a b ∈ q, a = b

def get (q) (h : @is_pure α q) : α := lift_on q id h

theorem get_mem {q : semiquot α} (p) : get q p ∈ q :=
let ⟨a, h⟩ := exists_mem q in
by unfold get; rw lift_on_of_mem q _ _ a h; exact h

theorem eq_pure {q : semiquot α} (p) : q = pure (get q p) :=
ext.2 $ λ a, by simp; exact
⟨λ h, p _ _ h (get_mem _), λ e, e.symm ▸ get_mem _⟩

@[simp] theorem pure_is_pure (a : α) : is_pure (pure a)
| b c ab ac := by simp at *; cc

theorem is_pure_iff {s : semiquot α} : is_pure s ↔ ∃ a, s = pure a :=
⟨λ h, ⟨_, eq_pure h⟩, λ ⟨a, e⟩, e.symm ▸ pure_is_pure _⟩

theorem is_pure.mono {s t : semiquot α}
  (st : s ≤ t) (h : is_pure t) : is_pure s
| a b as bs := h _ _ (st as) (st bs)

theorem is_pure.min {s t : semiquot α} (h : is_pure t) : s ≤ t ↔ s = t :=
⟨λ st, le_antisymm st $ by rw [eq_pure h, eq_pure (h.mono st)]; simp;
   exact h _ _ (get_mem _) (st $ get_mem _),
 le_of_eq⟩

theorem is_pure_of_subsingleton [subsingleton α] (q : semiquot α) : is_pure q
| a b aq bq := subsingleton.elim _ _

def univ [inhabited α] : semiquot α :=
mk $ set.mem_univ (default _)

@[simp] theorem mem_univ [inhabited α] : ∀ a, a ∈ @univ α _ :=
@set.mem_univ α

@[congr] theorem univ_unique (I J : inhabited α) : @univ _ I = @univ _ J :=
ext.2 $ by simp

@[simp] theorem is_pure_univ [inhabited α] : @is_pure α univ ↔ subsingleton α :=
⟨λ h, ⟨λ a b, h a b trivial trivial⟩, λ ⟨h⟩ a b _ _, h a b⟩

instance [inhabited α] : lattice.order_top (semiquot α) :=
{ top := univ,
  le_top := λ s, set.subset_univ _,
  ..semiquot.partial_order }

instance [inhabited α] : lattice.semilattice_sup_top (semiquot α) :=
{ ..semiquot.lattice.order_top,
  ..semiquot.lattice.semilattice_sup }

end semiquot


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison
Ported by: Scott Morrison

! This file was ported from Lean 3 source module category_theory.functor.basic
! leanprover-community/mathlib commit 8350c34a64b9bc3fc64335df8006bffcadc7baa6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Category.Basic
import Mathlib.Tactic.Reassoc

/-!
# Functors

Defines a functor between categories, extending a `Prefunctor` between quivers.

Introduces notation `C ⥤ D` for the type of all functors from `C` to `D`.
(Unfortunately the `⇒` arrow (`\functor`) is taken by core,
but in mathlib4 we should switch to this.)
-/

namespace CategoryTheory

-- declare the `v`'s first; see note [CategoryTheory universes].
universe v v₁ v₂ v₃ u u₁ u₂ u₃

section

/-- `Functor C D` represents a functor between categories `C` and `D`.

To apply a functor `F` to an object use `F.obj X`, and to a morphism use `F.map f`.

The axiom `map_id` expresses preservation of identities, and
`map_comp` expresses functoriality.

See <https://stacks.math.columbia.edu/tag/001B>.
-/
structure Functor (C : Type u₁) [Category.{v₁} C] (D : Type u₂) [Category.{v₂} D]
    extends Prefunctor C D : Type max v₁ v₂ u₁ u₂ where
  /-- A functor preserves identity morphisms. -/
  map_id : ∀ X : C, map (𝟙 X) = 𝟙 (obj X) := by aesop_cat
  /-- A functor preserves composition. -/
  map_comp : ∀ {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z), map (f ≫ g) = map f ≫ map g := by aesop_cat

#align category_theory.functor CategoryTheory.Functor
#align category_theory.functor.map_comp CategoryTheory.Functor.map_comp
#align category_theory.functor.map_id CategoryTheory.Functor.map_id

/-- The prefunctor between the underlying quivers. -/
add_decl_doc Functor.toPrefunctor
#align category_theory.functor.to_prefunctor CategoryTheory.Functor.toPrefunctor

/--
This unexpander will pretty print `F.obj X` properly.
Without this, we would have `Prefunctor.obj F.toPrefunctor X`.
-/
@[app_unexpander Prefunctor.obj] def
  unexpandFunctorObj : Lean.PrettyPrinter.Unexpander
  | `($_ $(F).toPrefunctor $(X)*)  => set_option hygiene false in `($(F).obj $(X)*)
  | _                           => throw ()

/--
This unexpander will pretty print `F.map f` properly.
Without this, we would have `Prefunctor.map F.toPrefunctor f`.
-/
@[app_unexpander Prefunctor.map] def
  unexpandFunctorMap : Lean.PrettyPrinter.Unexpander
  | `($_ $(F).toPrefunctor $(X)*)  => set_option hygiene false in `($(F).map $(X)*)
  | _                           => throw ()

end

/-- Notation for a functor between categories. -/
-- A functor is basically a function, so give ⥤ a similar precedence to → (25).
-- For example, `C × D ⥤ E` should parse as `(C × D) ⥤ E` not `C × (D ⥤ E)`.
infixr:26 " ⥤ " => Functor -- type as \func

attribute [simp] Functor.map_id
-- We intentionally don't add `simp` to the `reassoc` lemma,
-- which is only useful for rewriting backwards.
attribute [reassoc, simp] Functor.map_comp
#align category_theory.functor.map_comp_assoc CategoryTheory.Functor.map_comp_assoc

namespace Functor

section

variable (C : Type u₁) [Category.{v₁} C]

initialize_simps_projections Functor

-- We don't use `@[simps]` here because we want `C` implicit for the simp lemmas.
/-- `𝟭 C` is the identity functor on a category `C`. -/
protected def id : C ⥤ C where
  obj X := X
  map f := f
#align category_theory.functor.id CategoryTheory.Functor.id

/-- Notation for the identity functor on a category. -/
notation "𝟭" => Functor.id -- Type this as `\sb1`

instance : Inhabited (C ⥤ C) :=
  ⟨Functor.id C⟩

variable {C}

@[simp]
theorem id_obj (X : C) : (𝟭 C).obj X = X := rfl
#align category_theory.functor.id_obj CategoryTheory.Functor.id_obj

@[simp]
theorem id_map {X Y : C} (f : X ⟶ Y) : (𝟭 C).map f = f := rfl
#align category_theory.functor.id_map CategoryTheory.Functor.id_map

end

section

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

/-- `F ⋙ G` is the composition of a functor `F` and a functor `G` (`F` first, then `G`).
-/
@[simps obj]
def comp (F : C ⥤ D) (G : D ⥤ E) : C ⥤ E where
  obj X := G.obj (F.obj X)
  map f := G.map (F.map f)
#align category_theory.functor.comp CategoryTheory.Functor.comp
#align category_theory.functor.comp_obj CategoryTheory.Functor.comp_obj

/-- Notation for composition of functors. -/
infixr:80 " ⋙ " => comp

@[simp]
theorem comp_map (F : C ⥤ D) (G : D ⥤ E) {X Y : C} (f : X ⟶ Y) :
  (F ⋙ G).map f = G.map (F.map f) := rfl
#align category_theory.functor.comp_map CategoryTheory.Functor.comp_map

-- These are not simp lemmas because rewriting along equalities between functors
-- is not necessarily a good idea.
-- Natural isomorphisms are also provided in `whiskering.lean`.
protected theorem comp_id (F : C ⥤ D) : F ⋙ 𝟭 D = F := by cases F; rfl
#align category_theory.functor.comp_id CategoryTheory.Functor.comp_id

protected theorem id_comp (F : C ⥤ D) : 𝟭 C ⋙ F = F := by cases F; rfl
#align category_theory.functor.id_comp CategoryTheory.Functor.id_comp

@[simp]
theorem map_dite (F : C ⥤ D) {X Y : C} {P : Prop} [Decidable P]
    (f : P → (X ⟶ Y)) (g : ¬P → (X ⟶ Y)) :
    F.map (if h : P then f h else g h) = if h : P then F.map (f h) else F.map (g h) := by
  aesop_cat
#align category_theory.functor.map_dite CategoryTheory.Functor.map_dite

-- Porting note: `to_prefunctor_obj` and `to_prefunctor_map` are now tautologies,
-- so have not been ported.

@[simp]
theorem toPrefunctor_comp (F : C ⥤ D) (G : D ⥤ E) :
    F.toPrefunctor.comp G.toPrefunctor = (F ⋙ G).toPrefunctor := rfl
#align category_theory.functor.to_prefunctor_comp CategoryTheory.Functor.toPrefunctor_comp

end

end Functor

end CategoryTheory


import data.list.basic
import tactic.linarith

namespace relation

def left_total {α β} (R : α → β → Prop) :=
∀ x, ∃ y, R x y

def right_total {α β} (R : α → β → Prop) :=
left_total (flip R)

end relation

namespace punit

lemma punit_eq_iff (x y : punit) : x = y ↔ true := by casesm* punit; simp

end punit

namespace nat

@[simp]
lemma not_add_one_le_self {p : ℕ} : ¬ p + 1 ≤ p := nat.not_succ_le_self _

@[simp]
lemma not_one_add_le_self {p : ℕ} : ¬ 1 + p ≤ p := (one_add p).symm ▸ nat.not_succ_le_self _

end nat

namespace list
open nat

variables {α : Type*} {β : Type*}

@[simp]
def nth' : ℕ → list α → list α
| 0 [] := []
| 0 (x :: xs) := [x]
| (succ n) [] := []
| (succ n) (x :: xs) := nth' n xs

lemma exists_nth'_eq_of_lt (vs : list α) (i : ℕ) (h : i < length vs) : ∃ x, nth' i vs = [x] :=
begin
  induction vs generalizing i, cases h, cases i; dsimp [nth'], exact ⟨_,rfl⟩,
  apply vs_ih, apply lt_of_succ_lt_succ h
end

@[simp]
lemma nth'_map (f : α → β) (vs : list α) (i : ℕ) : nth' i (vs.map f) = (nth' i vs).map f :=
begin
  induction vs generalizing i, cases i; refl,
  cases i; dsimp [map,nth']; [refl, exact vs_ih _]
end

@[simp]
lemma nth'_enum (vs : list α) (i : ℕ) : nth' i vs.enum = (nth' i vs).enum_from i :=
begin
  suffices : nth' i (enum_from 0 vs) = enum_from (0 + i) (nth' i vs),
  { dsimp [enum], rw [this,zero_add] },
  generalize : 0 = k,
  induction vs generalizing i k, cases i; refl,
  cases i; dsimp [enum_from,nth'], refl, rw [vs_ih,succ_eq_add_one], ac_refl
end

lemma range_zero : range 0 = [] := rfl

lemma range'_zero (n : ℕ) : range' n 0 = [] := rfl

lemma cons_range' (n k : ℕ) : (n :: range' n.succ k : list _) = range' n k.succ := rfl

attribute [simp] length_enum

lemma length_eq_succ {α} (xs : list α) (n : ℕ) : xs.length = n.succ ↔ ∃ y ys, xs = y::ys ∧ ys.length = n :=
begin
  split,
  { intro h, cases xs, cases h, exact ⟨_,_,rfl,nat.succ_inj h⟩ },
  { rintro ⟨y,ys,h₀,h₁⟩, subst h₀, rw [list.length,h₁] }
end

end list

section logic

lemma exists_one_point {α} {p : α → Prop} (x : α) (h : ∀ y, p y → x = y) : (∃ y, p y) ↔ p x :=
⟨λ ⟨x',h'⟩, (h _ h').symm ▸ h', λ h', ⟨x,h'⟩ ⟩

end logic

@[user_attribute]
meta def interactive_attr : user_attribute :=
{ name := `interactive,
  descr := "inject definition into the `tactic.interactive` namespace",
  after_set := some $ λ n _ _, add_interactive [n]  }

namespace name

def drop_prefix : name → name
| anonymous := anonymous
| (mk_string s _) := mk_string s anonymous
| (mk_numeral n _) := mk_numeral n anonymous

end name

namespace tactic

meta def fail_if_unchanged {α} (tac : tactic α) : tactic α :=
do gs ← get_goals,
   r ← tac,
   gs' ← get_goals,
   r <$ guard (gs ≠ gs')

setup_tactic_parser
open list

@[interactive]
meta def duplicate_goal (n : parse small_nat) : tactic unit :=
focus1 $
do t ← target,
   gs ← (iota n).mmap (λ _, mk_meta_var t),
   [g] ← get_goals,
   set_goals (g :: gs)

-- meta def mk_instance_binder : expr → expr
-- | (expr.pi n _ d b) := expr.pi `_inst binder_info.inst_implicit d b
-- | e := e

-- meta def to_inst_implicit : expr → expr
-- | (expr.local_const uniq n bi t) := expr.local_const uniq n binder_info.inst_implicit t
-- | e := e

-- meta def cache_local_instances : tactic unit :=
-- do cxt ← local_context,
--    ns ← cxt.reverse.mmap $ λ l,
--      do { t ← infer_type l,
--           mcond (is_class t.get_app_fn) (revert l <* (target >>= unsafe_change ∘ mk_instance_binder)) (pure 0) },
--    intron ns.sum

-- #print partial_order
-- #check add_inductive

-- meta def force_local_type : expr → tactic expr
-- | e@`

-- meta def get_local_pis : ℕ → expr → tactic (list expr)
-- | 0 _ := pure []
-- | (nat.succ n) (pi nn bi )

-- meta def mk_le (n le_n : name) (ls : list name) (ps : list expr) : tactic expr :=
-- do cxt ← local_context,
--    env ← get_env,
--    -- let paramn := env.inductive_num_params n,
--    let cs := env.constructors_of n,
--    let cs' := do { (x,ys) ← cs.zip cs.tails,
--                    y ← ys,
--                    let c := le_n <.>
--                      (x.drop_prefix.to_string ++ "_le_" ++ y.drop_prefix.to_string),
--                    pure (x,y,c) },
--    let ps' := ps.map some,
--    cxt ← cxt.mmap $ λ l,
--      do { t ← infer_type l,
--           mcond (is_class t)
--             (pure $ to_inst_implicit l)
--             (pure $ to_implicit l) },
--    c ← mk_mapp n ps',
--    t ← pis cxt (c.imp $ c.imp `(Prop)),
--    let decl : expr := expr.const le_n $ ls.map level.param,
--    cs'' ← cs'.mmap $ λ ⟨c₀,c₁,cc⟩,
--    do { x ← mk_mapp c₀ ps',
--         y ← mk_mapp c₁ ps',
--         (xs, _) ← infer_type x >>= mk_local_pis,
--         (ys, _) ← infer_type y >>= mk_local_pis,
--         let hd := (decl.mk_app cxt (x.mk_app xs) (y.mk_app ys)),
--         t ← if c₀ = c₁
--           then do
--             hs ← mzip_with (λ x y : expr,
--               do t ← infer_type x,
--                  h ← mk_mapp `has_le.le [t,none,x,y],
--                  mk_local_def `h h) xs ys,
--             -- t ← pis hs hd,
--             pis (cxt ++ xs ++ ys ++ hs) hd
--           else pis (cxt ++ xs ++ ys) hd,
--         -- trace!"{t}, {t.list_local_consts}",
--         pure (cc,t) },
--    trace t,
--    trace "•",
--    add_inductive le_n ls cxt.length t cs'',
--    trace "•",
--    pure $ (expr.const le_n (ls.map level.param)).mk_app cxt

-- meta def prove_refl (t R : expr) : tactic expr :=
-- do x ← mk_local_def `x t,
--    t ← pis [x] (R x x),
--    prod.snd <$> solve_aux t (do
--      { x ← intro1, cs ← cases x,
--        all_goals (constructor >> applyc ``le_refl),
--        skip })

-- meta def prove_trans (t R : expr) : tactic expr :=
-- do env ← get_env,
--    let n := R.get_app_fn.const_name,
--    let rec_n := n <.> "rec",

--    x ← mk_local_def `x t,
--    y ← mk_local_def `y t,
--    z ← mk_local_def `z t,
--    h₀ ← mk_local_def `h₀ (R x y),
--    h₁ ← mk_local_def `h₁ (R y z),
--    t ← pis [x,y,z,h₀,h₁] (R x z),
--    prod.snd <$> solve_aux t (do
--      { [x,y,z,h₀,h₁] ← intros, cs ← induction h₀ [] rec_n,
--        gs ← get_goals,
--        trace "• A",
--        gs ← mzip_with (λ (g) c : name × list expr × list (name × expr),
--          do let ⟨a,b,c⟩ := c,
--             set_goals [g],
--             trace_state,
--             trace!"{h₁.to_raw_fmt} - {(h₁.instantiate_locals c).to_raw_fmt}\n{c}",
--             () <$ induction (h₁.instantiate_locals c) [] rec_n,
--             trace "• A",
--             get_goals ) gs cs,
--        trace "• A",
--        set_goals gs.join,
--        all_goals (constructor >> applyc ``le_refl),
--        skip })

-- meta def mk_linear_order_instance : tactic unit :=
-- do `(linear_order %%t) ← target,
--    let fn := t.get_app_fn,
--    let ps := t.get_app_args,
--    -- cache_local_instances,
--    guard (fn.is_constant) <|> fail "expecting a type applied to arguments: `fn a b c`",
--    let n := fn.const_name,
--    let le_n := n <.> "le",
--    env ← get_env,
--    let cs := env.constructors_of n,
--    let paramn := env.inductive_num_params n,
--    let cs' := do { (x,ys) ← cs.zip cs.tails,
--                    y ← ys,
--                    let c := le_n <.>
--                      (x.drop_prefix.to_string ++ "_le_" ++ y.drop_prefix.to_string),
--                    pure (x,y,c) },
--    d ← get_decl n,
--    let ls := d.univ_params,
--    guard (env.inductive_num_indices n = 0),
--    le ← mk_le n le_n ls ps,
--    le_refl ← prove_refl t le,
--    le_trans ← prove_trans t le,
--    refine ``( { linear_order .  le := %%le,
--                 le_refl := %%le_refl,
--                 le_trans := %%le_trans } )

-- -- #print instances decidable_linear_order

-- @[derive_handler]
-- meta def linear_order_derive_handler : derive_handler :=
-- instance_derive_handler ``linear_order mk_linear_order_instance

-- @[derive_handler]
-- meta def decidable_linear_order_derive_handler : derive_handler :=
-- instance_derive_handler ``decidable_linear_order mk_decidable_linear_order_instance

meta def simp_arg_type.to_tactic_format : simp_arg_type → tactic format
| simp_arg_type.all_hyps := pure "all_hyps"
| (simp_arg_type.except a) := (pformat!"- {a}" : pformat)
| (simp_arg_type.expr a) := pp a

meta instance simp_arg_type.has_to_tactic_format : has_to_tactic_format simp_arg_type :=
⟨ simp_arg_type.to_tactic_format ⟩

open interactive tactic.interactive

meta def interactive.repeat1 (tac : itactic) : tactic unit :=
let tac : tactic unit := tac in
tac ; repeat tac

meta def enclosing_def : tactic unit :=
do n ← decl_name,
   exact `(n)

meta def with_context (msg : format) (tac : itactic) (caller : name . enclosing_def) : tactic unit
| s := match tac s with
       | (result.success a a_1) := result.success a a_1
       | (result.exception (some msg') p s) :=
         (do result.exception (some $ λ _, format!"> {caller}\n{msg}\n\nPreviously:\n{msg' ()}") p) s
       | (result.exception none p s) :=
         (do result.exception (some $ λ _, format!"> {caller}\n{msg}") p) s
       end

precedence `with_context!`:0

@[user_notation]
meta def with_context_macro (_ : parse $ tk "with_context!") (xs : string) : lean.parser pexpr :=
do msg ← pformat_macro () xs,
   pure ``(λ tac, do x ← %%msg, tactic.with_context x tac)

run_cmd mk_simp_attr `linarith

@[interactive]
meta def linarith'
  (red : parse (tk "!")?)
  (restr : parse (tk "only")?) (hyps : parse pexpr_list?)
  (cfg : linarith.linarith_config := {}) : tactic unit :=
do `[simp only with linarith at * { fail_if_unchanged := ff } ],
   done <|> do
     intros,
     casesm (some ()) [``(Exists _), ``(_ ∧ _)],
     linarith red restr hyps cfg

attribute [linarith] nat.succ_eq_add_one list.length

end tactic

-- @[linarith]
-- lemma dvd_iff_exists {α} [comm_semiring α] (x y : α) : x ∣ y ↔ ∃ z, y = x * z := iff.refl _

-- open list

-- example {x y : ℕ}
--   -- (h : x ∣ y)
--   (h' : x = length [x,y])
--   (h'' : y > 0) :
--   x > 0 :=
-- begin
--   -- dsimp [has_dvd.dvd] at h,
--   linarith',
-- end

-- set_option trace.app_builder true

-- open tactic tactic.interactive

-- meta def other_def : tactic unit :=
-- with_context ↑"other" (tactic.fail "bar error")

-- meta def foo_def : tactic unit :=
-- by with_context ↑"foo" other_def

-- attribute [derive linear_order] sum

-- @[derive linear_order]
-- inductive foo (α : Type)
-- | left : α → ℕ → foo
-- | mid : foo
-- | right : ℕ → foo

-- attribute [derive decidable_linear_order] sum


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.punit_instances
import linear_algebra.finsupp
import ring_theory.ideal.over
import ring_theory.ideal.prod
import ring_theory.localization.away
import ring_theory.nilpotent
import topology.sets.closeds
import topology.sober

/-!
# Prime spectrum of a commutative ring

The prime spectrum of a commutative ring is the type of all prime ideals.
It is naturally endowed with a topology: the Zariski topology.

(It is also naturally endowed with a sheaf of rings,
which is constructed in `algebraic_geometry.structure_sheaf`.)

## Main definitions

* `prime_spectrum R`: The prime spectrum of a commutative ring `R`,
  i.e., the set of all prime ideals of `R`.
* `zero_locus s`: The zero locus of a subset `s` of `R`
  is the subset of `prime_spectrum R` consisting of all prime ideals that contain `s`.
* `vanishing_ideal t`: The vanishing ideal of a subset `t` of `prime_spectrum R`
  is the intersection of points in `t` (viewed as prime ideals).

## Conventions

We denote subsets of rings with `s`, `s'`, etc...
whereas we denote subsets of prime spectra with `t`, `t'`, etc...

## Inspiration/contributors

The contents of this file draw inspiration from <https://github.com/ramonfmir/lean-scheme>
which has contributions from Ramon Fernandez Mir, Kevin Buzzard, Kenny Lau,
and Chris Hughes (on an earlier repository).
-/

noncomputable theory
open_locale classical

universes u v

variables (R : Type u) (S : Type v) [comm_ring R] [comm_ring S]

/-- The prime spectrum of a commutative ring `R` is the type of all prime ideals of `R`.

It is naturally endowed with a topology (the Zariski topology),
and a sheaf of commutative rings (see `algebraic_geometry.structure_sheaf`).
It is a fundamental building block in algebraic geometry. -/
@[ext] structure prime_spectrum :=
(as_ideal : ideal R)
(is_prime : as_ideal.is_prime)

attribute [instance] prime_spectrum.is_prime

namespace prime_spectrum

variables {R S}

instance [nontrivial R] : nonempty $ prime_spectrum R :=
let ⟨I, hI⟩ := ideal.exists_maximal R in ⟨⟨I, hI.is_prime⟩⟩

/-- The prime spectrum of the zero ring is empty. -/
lemma punit (x : prime_spectrum punit) : false :=
x.1.ne_top_iff_one.1 x.2.1 $ subsingleton.elim (0 : punit) 1 ▸ x.1.zero_mem

variables (R S)

/-- The map from the direct sum of prime spectra to the prime spectrum of a direct product. -/
@[simp] def prime_spectrum_prod_of_sum :
  prime_spectrum R ⊕ prime_spectrum S → prime_spectrum (R × S)
| (sum.inl ⟨I, hI⟩) := ⟨ideal.prod I ⊤, by exactI ideal.is_prime_ideal_prod_top⟩
| (sum.inr ⟨J, hJ⟩) := ⟨ideal.prod ⊤ J, by exactI ideal.is_prime_ideal_prod_top'⟩

/-- The prime spectrum of `R × S` is in bijection with the disjoint unions of the prime spectrum of
`R` and the prime spectrum of `S`. -/
noncomputable def prime_spectrum_prod :
  prime_spectrum (R × S) ≃ prime_spectrum R ⊕ prime_spectrum S :=
equiv.symm $ equiv.of_bijective (prime_spectrum_prod_of_sum R S)
begin
  split,
  { rintro (⟨I, hI⟩|⟨J, hJ⟩) (⟨I', hI'⟩|⟨J', hJ'⟩) h;
    simp only [ideal.prod.ext_iff, prime_spectrum_prod_of_sum] at h,
    { simp only [h] },
    { exact false.elim (hI.ne_top h.left) },
    { exact false.elim (hJ.ne_top h.right) },
    { simp only [h] } },
  { rintro ⟨I, hI⟩,
    rcases (ideal.ideal_prod_prime I).mp hI with (⟨p, ⟨hp, rfl⟩⟩|⟨p, ⟨hp, rfl⟩⟩),
    { exact ⟨sum.inl ⟨p, hp⟩, rfl⟩ },
    { exact ⟨sum.inr ⟨p, hp⟩, rfl⟩ } }
end

variables {R S}

@[simp] lemma prime_spectrum_prod_symm_inl_as_ideal (x : prime_spectrum R) :
  ((prime_spectrum_prod R S).symm $ sum.inl x).as_ideal = ideal.prod x.as_ideal ⊤ :=
by { cases x, refl }

@[simp] lemma prime_spectrum_prod_symm_inr_as_ideal (x : prime_spectrum S) :
  ((prime_spectrum_prod R S).symm $ sum.inr x).as_ideal = ideal.prod ⊤ x.as_ideal :=
by { cases x, refl }

/-- The zero locus of a set `s` of elements of a commutative ring `R` is the set of all prime ideals
of the ring that contain the set `s`.

An element `f` of `R` can be thought of as a dependent function on the prime spectrum of `R`.
At a point `x` (a prime ideal) the function (i.e., element) `f` takes values in the quotient ring
`R` modulo the prime ideal `x`. In this manner, `zero_locus s` is exactly the subset of
`prime_spectrum R` where all "functions" in `s` vanish simultaneously.
-/
def zero_locus (s : set R) : set (prime_spectrum R) :=
{x | s ⊆ x.as_ideal}

@[simp] lemma mem_zero_locus (x : prime_spectrum R) (s : set R) :
  x ∈ zero_locus s ↔ s ⊆ x.as_ideal := iff.rfl

@[simp] lemma zero_locus_span (s : set R) :
  zero_locus (ideal.span s : set R) = zero_locus s :=
by { ext x, exact (submodule.gi R R).gc s x.as_ideal }

/-- The vanishing ideal of a set `t` of points of the prime spectrum of a commutative ring `R` is
the intersection of all the prime ideals in the set `t`.

An element `f` of `R` can be thought of as a dependent function on the prime spectrum of `R`.
At a point `x` (a prime ideal) the function (i.e., element) `f` takes values in the quotient ring
`R` modulo the prime ideal `x`. In this manner, `vanishing_ideal t` is exactly the ideal of `R`
consisting of all "functions" that vanish on all of `t`.
-/
def vanishing_ideal (t : set (prime_spectrum R)) : ideal R :=
⨅ (x : prime_spectrum R) (h : x ∈ t), x.as_ideal

lemma coe_vanishing_ideal (t : set (prime_spectrum R)) :
  (vanishing_ideal t : set R) = {f : R | ∀ x : prime_spectrum R, x ∈ t → f ∈ x.as_ideal} :=
begin
  ext f,
  rw [vanishing_ideal, set_like.mem_coe, submodule.mem_infi],
  apply forall_congr, intro x,
  rw [submodule.mem_infi],
end

lemma mem_vanishing_ideal (t : set (prime_spectrum R)) (f : R) :
  f ∈ vanishing_ideal t ↔ ∀ x : prime_spectrum R, x ∈ t → f ∈ x.as_ideal :=
by rw [← set_like.mem_coe, coe_vanishing_ideal, set.mem_set_of_eq]

@[simp] lemma vanishing_ideal_singleton (x : prime_spectrum R) :
  vanishing_ideal ({x} : set (prime_spectrum R)) = x.as_ideal :=
by simp [vanishing_ideal]

lemma subset_zero_locus_iff_le_vanishing_ideal (t : set (prime_spectrum R)) (I : ideal R) :
  t ⊆ zero_locus I ↔ I ≤ vanishing_ideal t :=
⟨λ h f k, (mem_vanishing_ideal _ _).mpr (λ x j, (mem_zero_locus _ _).mpr (h j) k), λ h,
  λ x j, (mem_zero_locus _ _).mpr (le_trans h (λ f h, ((mem_vanishing_ideal _ _).mp h) x j))⟩

section gc
variable (R)

/-- `zero_locus` and `vanishing_ideal` form a galois connection. -/
lemma gc : @galois_connection (ideal R) (set (prime_spectrum R))ᵒᵈ _ _
  (λ I, zero_locus I) (λ t, vanishing_ideal t) :=
λ I t, subset_zero_locus_iff_le_vanishing_ideal t I

/-- `zero_locus` and `vanishing_ideal` form a galois connection. -/
lemma gc_set : @galois_connection (set R) (set (prime_spectrum R))ᵒᵈ _ _
  (λ s, zero_locus s) (λ t, vanishing_ideal t) :=
have ideal_gc : galois_connection (ideal.span) coe := (submodule.gi R R).gc,
by simpa [zero_locus_span, function.comp] using ideal_gc.compose (gc R)

lemma subset_zero_locus_iff_subset_vanishing_ideal (t : set (prime_spectrum R)) (s : set R) :
  t ⊆ zero_locus s ↔ s ⊆ vanishing_ideal t :=
(gc_set R) s t

end gc

lemma subset_vanishing_ideal_zero_locus (s : set R) :
  s ⊆ vanishing_ideal (zero_locus s) :=
(gc_set R).le_u_l s

lemma le_vanishing_ideal_zero_locus (I : ideal R) :
  I ≤ vanishing_ideal (zero_locus I) :=
(gc R).le_u_l I

@[simp] lemma vanishing_ideal_zero_locus_eq_radical (I : ideal R) :
  vanishing_ideal (zero_locus (I : set R)) = I.radical := ideal.ext $ λ f,
begin
  rw [mem_vanishing_ideal, ideal.radical_eq_Inf, submodule.mem_Inf],
  exact ⟨(λ h x hx, h ⟨x, hx.2⟩ hx.1), (λ h x hx, h x.1 ⟨hx, x.2⟩)⟩
end

@[simp] lemma zero_locus_radical (I : ideal R) : zero_locus (I.radical : set R) = zero_locus I :=
vanishing_ideal_zero_locus_eq_radical I ▸ (gc R).l_u_l_eq_l I

lemma subset_zero_locus_vanishing_ideal (t : set (prime_spectrum R)) :
  t ⊆ zero_locus (vanishing_ideal t) :=
(gc R).l_u_le t

lemma zero_locus_anti_mono {s t : set R} (h : s ⊆ t) : zero_locus t ⊆ zero_locus s :=
(gc_set R).monotone_l h

lemma zero_locus_anti_mono_ideal {s t : ideal R} (h : s ≤ t) :
  zero_locus (t : set R) ⊆ zero_locus (s : set R) :=
(gc R).monotone_l h

lemma vanishing_ideal_anti_mono {s t : set (prime_spectrum R)} (h : s ⊆ t) :
  vanishing_ideal t ≤ vanishing_ideal s :=
(gc R).monotone_u h

lemma zero_locus_subset_zero_locus_iff (I J : ideal R) :
  zero_locus (I : set R) ⊆ zero_locus (J : set R) ↔ J ≤ I.radical :=
⟨λ h, ideal.radical_le_radical_iff.mp (vanishing_ideal_zero_locus_eq_radical I ▸
  vanishing_ideal_zero_locus_eq_radical J ▸ vanishing_ideal_anti_mono h),
λ h, zero_locus_radical I ▸ zero_locus_anti_mono_ideal h⟩

lemma zero_locus_subset_zero_locus_singleton_iff (f g : R) :
  zero_locus ({f} : set R) ⊆ zero_locus {g} ↔ g ∈ (ideal.span ({f} : set R)).radical :=
by rw [← zero_locus_span {f}, ← zero_locus_span {g}, zero_locus_subset_zero_locus_iff,
    ideal.span_le, set.singleton_subset_iff, set_like.mem_coe]

lemma zero_locus_bot :
  zero_locus ((⊥ : ideal R) : set R) = set.univ :=
(gc R).l_bot

@[simp] lemma zero_locus_singleton_zero :
  zero_locus ({0} : set R) = set.univ :=
zero_locus_bot

@[simp] lemma zero_locus_empty :
  zero_locus (∅ : set R) = set.univ :=
(gc_set R).l_bot

@[simp] lemma vanishing_ideal_univ :
  vanishing_ideal (∅ : set (prime_spectrum R)) = ⊤ :=
by simpa using (gc R).u_top

lemma zero_locus_empty_of_one_mem {s : set R} (h : (1:R) ∈ s) :
  zero_locus s = ∅ :=
begin
  rw set.eq_empty_iff_forall_not_mem,
  intros x hx,
  rw mem_zero_locus at hx,
  have x_prime : x.as_ideal.is_prime := by apply_instance,
  have eq_top : x.as_ideal = ⊤, { rw ideal.eq_top_iff_one, exact hx h },
  apply x_prime.ne_top eq_top,
end

@[simp] lemma zero_locus_singleton_one :
  zero_locus ({1} : set R) = ∅ :=
zero_locus_empty_of_one_mem (set.mem_singleton (1 : R))

lemma zero_locus_empty_iff_eq_top {I : ideal R} :
  zero_locus (I : set R) = ∅ ↔ I = ⊤ :=
begin
  split,
  { contrapose!,
    intro h,
    rcases ideal.exists_le_maximal I h with ⟨M, hM, hIM⟩,
    exact set.nonempty.ne_empty ⟨⟨M, hM.is_prime⟩, hIM⟩ },
  { rintro rfl, apply zero_locus_empty_of_one_mem, trivial }
end

@[simp] lemma zero_locus_univ :
  zero_locus (set.univ : set R) = ∅ :=
zero_locus_empty_of_one_mem (set.mem_univ 1)

lemma vanishing_ideal_eq_top_iff {s : set (prime_spectrum R)} : vanishing_ideal s = ⊤ ↔ s = ∅ :=
by rw [← top_le_iff, ← subset_zero_locus_iff_le_vanishing_ideal,
       submodule.top_coe, zero_locus_univ, set.subset_empty_iff]

lemma zero_locus_sup (I J : ideal R) :
  zero_locus ((I ⊔ J : ideal R) : set R) = zero_locus I ∩ zero_locus J :=
(gc R).l_sup

lemma zero_locus_union (s s' : set R) :
  zero_locus (s ∪ s') = zero_locus s ∩ zero_locus s' :=
(gc_set R).l_sup

lemma vanishing_ideal_union (t t' : set (prime_spectrum R)) :
  vanishing_ideal (t ∪ t') = vanishing_ideal t ⊓ vanishing_ideal t' :=
(gc R).u_inf

lemma zero_locus_supr {ι : Sort*} (I : ι → ideal R) :
  zero_locus ((⨆ i, I i : ideal R) : set R) = (⋂ i, zero_locus (I i)) :=
(gc R).l_supr

lemma zero_locus_Union {ι : Sort*} (s : ι → set R) :
  zero_locus (⋃ i, s i) = (⋂ i, zero_locus (s i)) :=
(gc_set R).l_supr

lemma zero_locus_bUnion (s : set (set R)) :
  zero_locus (⋃ s' ∈ s, s' : set R) = ⋂ s' ∈ s, zero_locus s' :=
by simp only [zero_locus_Union]

lemma vanishing_ideal_Union {ι : Sort*} (t : ι → set (prime_spectrum R)) :
  vanishing_ideal (⋃ i, t i) = (⨅ i, vanishing_ideal (t i)) :=
(gc R).u_infi

lemma zero_locus_inf (I J : ideal R) :
  zero_locus ((I ⊓ J : ideal R) : set R) = zero_locus I ∪ zero_locus J :=
set.ext $ λ x, x.2.inf_le

lemma union_zero_locus (s s' : set R) :
  zero_locus s ∪ zero_locus s' = zero_locus ((ideal.span s) ⊓ (ideal.span s') : ideal R) :=
by { rw zero_locus_inf, simp }

lemma zero_locus_mul (I J : ideal R) :
  zero_locus ((I * J : ideal R) : set R) = zero_locus I ∪ zero_locus J :=
set.ext $ λ x, x.2.mul_le

lemma zero_locus_singleton_mul (f g : R) :
  zero_locus ({f * g} : set R) = zero_locus {f} ∪ zero_locus {g} :=
set.ext $ λ x, by simpa using x.2.mul_mem_iff_mem_or_mem

@[simp] lemma zero_locus_pow (I : ideal R) {n : ℕ} (hn : 0 < n) :
  zero_locus ((I ^ n : ideal R) : set R) = zero_locus I :=
zero_locus_radical (I ^ n) ▸ (I.radical_pow n hn).symm ▸ zero_locus_radical I

@[simp] lemma zero_locus_singleton_pow (f : R) (n : ℕ) (hn : 0 < n) :
  zero_locus ({f ^ n} : set R) = zero_locus {f} :=
set.ext $ λ x, by simpa using x.2.pow_mem_iff_mem n hn

lemma sup_vanishing_ideal_le (t t' : set (prime_spectrum R)) :
  vanishing_ideal t ⊔ vanishing_ideal t' ≤ vanishing_ideal (t ∩ t') :=
begin
  intros r,
  rw [submodule.mem_sup, mem_vanishing_ideal],
  rintro ⟨f, hf, g, hg, rfl⟩ x ⟨hxt, hxt'⟩,
  rw mem_vanishing_ideal at hf hg,
  apply submodule.add_mem; solve_by_elim
end

lemma mem_compl_zero_locus_iff_not_mem {f : R} {I : prime_spectrum R} :
  I ∈ (zero_locus {f} : set (prime_spectrum R))ᶜ ↔ f ∉ I.as_ideal :=
by rw [set.mem_compl_iff, mem_zero_locus, set.singleton_subset_iff]; refl

/-- The Zariski topology on the prime spectrum of a commutative ring is defined via the closed sets
of the topology: they are exactly those sets that are the zero locus of a subset of the ring. -/
instance zariski_topology : topological_space (prime_spectrum R) :=
topological_space.of_closed (set.range prime_spectrum.zero_locus)
  (⟨set.univ, by simp⟩)
  begin
    intros Zs h,
    rw set.sInter_eq_Inter,
    choose f hf using λ i : Zs, h i.prop,
    simp only [← hf],
    exact ⟨_, zero_locus_Union _⟩
  end
  (by { rintro _ ⟨s, rfl⟩ _ ⟨t, rfl⟩, exact ⟨_, (union_zero_locus s t).symm⟩ })

lemma is_open_iff (U : set (prime_spectrum R)) :
  is_open U ↔ ∃ s, Uᶜ = zero_locus s :=
by simp only [@eq_comm _ Uᶜ]; refl

lemma is_closed_iff_zero_locus (Z : set (prime_spectrum R)) :
  is_closed Z ↔ ∃ s, Z = zero_locus s :=
by rw [← is_open_compl_iff, is_open_iff, compl_compl]

lemma is_closed_iff_zero_locus_ideal (Z : set (prime_spectrum R)) :
  is_closed Z ↔ ∃ (I : ideal R), Z = zero_locus I :=
(is_closed_iff_zero_locus _).trans
  ⟨λ ⟨s, hs⟩, ⟨_, (zero_locus_span s).substr hs⟩, λ ⟨I, hI⟩, ⟨I, hI⟩⟩

lemma is_closed_iff_zero_locus_radical_ideal (Z : set (prime_spectrum R)) :
  is_closed Z ↔ ∃ (I : ideal R), I.is_radical ∧ Z = zero_locus I :=
(is_closed_iff_zero_locus_ideal _).trans
  ⟨λ ⟨I, hI⟩, ⟨_, I.radical_is_radical, (zero_locus_radical I).substr hI⟩, λ ⟨I, _, hI⟩, ⟨I, hI⟩⟩

lemma is_closed_zero_locus (s : set R) :
  is_closed (zero_locus s) :=
by { rw [is_closed_iff_zero_locus], exact ⟨s, rfl⟩ }

lemma is_closed_singleton_iff_is_maximal (x : prime_spectrum R) :
  is_closed ({x} : set (prime_spectrum R)) ↔ x.as_ideal.is_maximal :=
begin
  refine (is_closed_iff_zero_locus _).trans ⟨λ h, _, λ h, _⟩,
  { obtain ⟨s, hs⟩ := h,
    rw [eq_comm, set.eq_singleton_iff_unique_mem] at hs,
    refine ⟨⟨x.2.1, λ I hI, not_not.1 (mt (ideal.exists_le_maximal I) $
      not_exists.2 (λ J, not_and.2 $ λ hJ hIJ,_))⟩⟩,
    exact ne_of_lt (lt_of_lt_of_le hI hIJ) (symm $ congr_arg prime_spectrum.as_ideal
      (hs.2 ⟨J, hJ.is_prime⟩ (λ r hr, hIJ (le_of_lt hI $ hs.1 hr)))) },
  { refine ⟨x.as_ideal.1, _⟩,
    rw [eq_comm, set.eq_singleton_iff_unique_mem],
    refine ⟨λ _ h, h, λ y hy, prime_spectrum.ext _ _ (h.eq_of_le y.2.ne_top hy).symm⟩ }
end

lemma zero_locus_vanishing_ideal_eq_closure (t : set (prime_spectrum R)) :
  zero_locus (vanishing_ideal t : set R) = closure t :=
begin
  apply set.subset.antisymm,
  { rintro x hx t' ⟨ht', ht⟩,
    obtain ⟨fs, rfl⟩ : ∃ s, t' = zero_locus s,
    by rwa [is_closed_iff_zero_locus] at ht',
    rw [subset_zero_locus_iff_subset_vanishing_ideal] at ht,
    exact set.subset.trans ht hx },
  { rw (is_closed_zero_locus _).closure_subset_iff,
    exact subset_zero_locus_vanishing_ideal t }
end

lemma vanishing_ideal_closure (t : set (prime_spectrum R)) :
  vanishing_ideal (closure t) = vanishing_ideal t :=
zero_locus_vanishing_ideal_eq_closure t ▸ (gc R).u_l_u_eq_u t

lemma closure_singleton (x) : closure ({x} : set (prime_spectrum R)) = zero_locus x.as_ideal :=
by rw [← zero_locus_vanishing_ideal_eq_closure, vanishing_ideal_singleton]

lemma is_radical_vanishing_ideal (s : set (prime_spectrum R)) :
  (vanishing_ideal s).is_radical :=
by { rw [← vanishing_ideal_closure, ← zero_locus_vanishing_ideal_eq_closure,
  vanishing_ideal_zero_locus_eq_radical], apply ideal.radical_is_radical }

lemma vanishing_ideal_anti_mono_iff {s t : set (prime_spectrum R)}
  (ht : is_closed t) : s ⊆ t ↔ vanishing_ideal t ≤ vanishing_ideal s :=
⟨vanishing_ideal_anti_mono, λ h,
begin
  rw [← ht.closure_subset_iff, ← ht.closure_eq],
  convert ← zero_locus_anti_mono_ideal h;
  apply zero_locus_vanishing_ideal_eq_closure,
end⟩

lemma vanishing_ideal_strict_anti_mono_iff {s t : set (prime_spectrum R)}
  (hs : is_closed s) (ht : is_closed t) :
  s ⊂ t ↔ vanishing_ideal t < vanishing_ideal s :=
by rw [set.ssubset_def, vanishing_ideal_anti_mono_iff hs,
       vanishing_ideal_anti_mono_iff ht, lt_iff_le_not_le]

/-- The antitone order embedding of closed subsets of `Spec R` into ideals of `R`. -/
def closeds_embedding (R : Type*) [comm_ring R] :
  (topological_space.closeds $ prime_spectrum R)ᵒᵈ ↪o ideal R :=
order_embedding.of_map_le_iff (λ s, vanishing_ideal s.of_dual)
  (λ s t, (vanishing_ideal_anti_mono_iff s.2).symm)

lemma t1_space_iff_is_field [is_domain R] :
  t1_space (prime_spectrum R) ↔ is_field R :=
begin
  refine ⟨_, λ h, _⟩,
  { introI h,
    have hbot : ideal.is_prime (⊥ : ideal R) := ideal.bot_prime,
    exact not_not.1 (mt (ring.ne_bot_of_is_maximal_of_not_is_field $
      (is_closed_singleton_iff_is_maximal _).1 (t1_space.t1 ⟨⊥, hbot⟩)) (not_not.2 rfl)) },
  { refine ⟨λ x, (is_closed_singleton_iff_is_maximal x).2 _⟩,
    by_cases hx : x.as_ideal = ⊥,
    { letI := h.to_field, exact hx.symm ▸ ideal.bot_is_maximal },
    { exact absurd h (ring.not_is_field_iff_exists_prime.2 ⟨x.as_ideal, ⟨hx, x.2⟩⟩) } }
end

local notation `Z(` a `)` := zero_locus (a : set R)

lemma is_irreducible_zero_locus_iff (I : ideal R) :
  is_irreducible (zero_locus (I : set R)) ↔ I.radical.is_prime :=
zero_locus_radical I ▸ is_irreducible_zero_locus_iff_of_radical _ I.radical_is_radical

lemma is_irreducible_iff_vanishing_ideal_is_prime {s : set (prime_spectrum R)} :
  is_irreducible s ↔ (vanishing_ideal s).is_prime :=
by rw [← is_irreducible_iff_closure, ← zero_locus_vanishing_ideal_eq_closure,
  is_irreducible_zero_locus_iff_of_radical _ (is_radical_vanishing_ideal s)]

instance [is_domain R] : irreducible_space (prime_spectrum R) :=
begin
  rw [irreducible_space_def, set.top_eq_univ, ← zero_locus_bot, is_irreducible_zero_locus_iff],
  simpa using ideal.bot_prime
end

instance : quasi_sober (prime_spectrum R) :=
⟨λ S h₁ h₂, ⟨⟨_, is_irreducible_iff_vanishing_ideal_is_prime.1 h₁⟩,
 by rw [is_generic_point, closure_singleton, zero_locus_vanishing_ideal_eq_closure, h₂.closure_eq]⟩⟩

section comap
variables {S' : Type*} [comm_ring S']

lemma preimage_comap_zero_locus_aux (f : R →+* S) (s : set R) :
  (λ y, ⟨ideal.comap f y.as_ideal, infer_instance⟩ :
    prime_spectrum S → prime_spectrum R) ⁻¹' (zero_locus s) = zero_locus (f '' s) :=
begin
  ext x,
  simp only [mem_zero_locus, set.image_subset_iff],
  refl
end

/-- The function between prime spectra of commutative rings induced by a ring homomorphism.
This function is continuous. -/
def comap (f : R →+* S) : C(prime_spectrum S, prime_spectrum R) :=
{ to_fun := λ y, ⟨ideal.comap f y.as_ideal, infer_instance⟩,
  continuous_to_fun :=
    begin
      simp only [continuous_iff_is_closed, is_closed_iff_zero_locus],
      rintro _ ⟨s, rfl⟩,
      exact ⟨_, preimage_comap_zero_locus_aux f s⟩
    end }

variables (f : R →+* S)

@[simp] lemma comap_as_ideal (y : prime_spectrum S) :
  (comap f y).as_ideal = ideal.comap f y.as_ideal :=
rfl

@[simp] lemma comap_id : comap (ring_hom.id R) = continuous_map.id _ := by { ext, refl }

@[simp] lemma comap_comp (f : R →+* S) (g : S →+* S') :
  comap (g.comp f) = (comap f).comp (comap g) :=
rfl

lemma comap_comp_apply (f : R →+* S) (g : S →+* S') (x : prime_spectrum S') :
  prime_spectrum.comap (g.comp f) x = (prime_spectrum.comap f) (prime_spectrum.comap g x) :=
rfl

@[simp] lemma preimage_comap_zero_locus (s : set R) :
  (comap f) ⁻¹' (zero_locus s) = zero_locus (f '' s) :=
preimage_comap_zero_locus_aux f s

lemma comap_injective_of_surjective (f : R →+* S) (hf : function.surjective f) :
  function.injective (comap f) :=
λ x y h, prime_spectrum.ext _ _ (ideal.comap_injective_of_surjective f hf
  (congr_arg prime_spectrum.as_ideal h : (comap f x).as_ideal = (comap f y).as_ideal))

lemma comap_singleton_is_closed_of_surjective (f : R →+* S) (hf : function.surjective f)
  (x : prime_spectrum S) (hx : is_closed ({x} : set (prime_spectrum S))) :
  is_closed ({comap f x} : set (prime_spectrum R)) :=
begin
  haveI : x.as_ideal.is_maximal := (is_closed_singleton_iff_is_maximal x).1 hx,
  exact (is_closed_singleton_iff_is_maximal _).2 (ideal.comap_is_maximal_of_surjective f hf)
end

lemma comap_singleton_is_closed_of_is_integral (f : R →+* S) (hf : f.is_integral)
  (x : prime_spectrum S) (hx : is_closed ({x} : set (prime_spectrum S))) :
  is_closed ({comap f x} : set (prime_spectrum R)) :=
(is_closed_singleton_iff_is_maximal _).2 (ideal.is_maximal_comap_of_is_integral_of_is_maximal'
  f hf x.as_ideal $ (is_closed_singleton_iff_is_maximal x).1 hx)

variable S

lemma localization_comap_inducing [algebra R S] (M : submonoid R)
  [is_localization M S] : inducing (comap (algebra_map R S)) :=
begin
  constructor,
  rw topological_space_eq_iff,
  intro U,
  simp_rw ← is_closed_compl_iff,
  generalize : Uᶜ = Z,
  simp_rw [is_closed_induced_iff, is_closed_iff_zero_locus],
  split,
  { rintro ⟨s, rfl⟩,
    refine ⟨_,⟨(algebra_map R S) ⁻¹' (ideal.span s),rfl⟩,_⟩,
    rw [preimage_comap_zero_locus, ← zero_locus_span, ← zero_locus_span s],
    congr' 1,
    exact congr_arg submodule.carrier (is_localization.map_comap M S (ideal.span s)) },
  { rintro ⟨_, ⟨t, rfl⟩, rfl⟩, simp }
end

lemma localization_comap_injective [algebra R S] (M : submonoid R)
  [is_localization M S] : function.injective (comap (algebra_map R S)) :=
begin
  intros p q h,
  replace h := congr_arg (λ (x : prime_spectrum R), ideal.map (algebra_map R S) x.as_ideal) h,
  dsimp only at h,
  erw [is_localization.map_comap M S, is_localization.map_comap M S] at h,
  ext1,
  exact h
end

lemma localization_comap_embedding [algebra R S] (M : submonoid R)
  [is_localization M S] : embedding (comap (algebra_map R S)) :=
⟨localization_comap_inducing S M, localization_comap_injective S M⟩

lemma localization_comap_range [algebra R S] (M : submonoid R)
  [is_localization M S] :
  set.range (comap (algebra_map R S)) = { p | disjoint (M : set R) p.as_ideal } :=
begin
  ext x,
  split,
  { simp_rw disjoint_iff_inf_le,
    rintro ⟨p, rfl⟩ x ⟨hx₁, hx₂⟩,
    exact (p.2.1 : ¬ _)
      (p.as_ideal.eq_top_of_is_unit_mem hx₂ (is_localization.map_units S ⟨x, hx₁⟩)) },
  { intro h,
    use ⟨x.as_ideal.map (algebra_map R S),
      is_localization.is_prime_of_is_prime_disjoint M S _ x.2 h⟩,
    ext1,
    exact is_localization.comap_map_of_is_prime_disjoint M S _ x.2 h }
end

section spec_of_surjective
/-! The comap of a surjective ring homomorphism is a closed embedding between the prime spectra. -/

open function ring_hom

lemma comap_inducing_of_surjective (hf : surjective f) : inducing (comap f) :=
{ induced := begin
    simp_rw [topological_space_eq_iff, ←is_closed_compl_iff, is_closed_induced_iff,
      is_closed_iff_zero_locus],
    refine λ s, ⟨λ ⟨F, hF⟩, ⟨zero_locus (f ⁻¹' F), ⟨f ⁻¹' F, rfl⟩,
      by rw [preimage_comap_zero_locus, surjective.image_preimage hf, hF]⟩, _⟩,
    rintros ⟨-, ⟨F, rfl⟩, hF⟩,
    exact ⟨f '' F, hF.symm.trans (preimage_comap_zero_locus f F)⟩,
  end }

lemma image_comap_zero_locus_eq_zero_locus_comap (hf : surjective f) (I : ideal S) :
  comap f '' zero_locus I = zero_locus (I.comap f) :=
begin
  simp only [set.ext_iff, set.mem_image, mem_zero_locus, set_like.coe_subset_coe],
  refine λ p, ⟨_, λ h_I_p, _⟩,
  { rintro ⟨p, hp, rfl⟩ a ha,
    exact hp ha },
  { have hp : ker f ≤ p.as_ideal := (ideal.comap_mono bot_le).trans h_I_p,
    refine ⟨⟨p.as_ideal.map f, ideal.map_is_prime_of_surjective hf hp⟩, λ x hx, _, _⟩,
    { obtain ⟨x', rfl⟩ := hf x,
      exact ideal.mem_map_of_mem f (h_I_p hx) },
    { ext x,
      change f x ∈ p.as_ideal.map f ↔ _,
      rw ideal.mem_map_iff_of_surjective f hf,
      refine ⟨_, λ hx, ⟨x, hx, rfl⟩⟩,
      rintros ⟨x', hx', heq⟩,
      rw ← sub_sub_cancel x' x,
      refine p.as_ideal.sub_mem hx' (hp _),
      rwa [mem_ker, map_sub, sub_eq_zero] } },
end

lemma range_comap_of_surjective (hf : surjective f) :
  set.range (comap f) = zero_locus (ker f) :=
begin
  rw ← set.image_univ,
  convert image_comap_zero_locus_eq_zero_locus_comap _ _ hf _,
  rw zero_locus_bot,
end

lemma is_closed_range_comap_of_surjective (hf : surjective f) : is_closed (set.range (comap f)) :=
begin
  rw range_comap_of_surjective _ f hf,
  exact is_closed_zero_locus ↑(ker f),
end

lemma closed_embedding_comap_of_surjective (hf : surjective f) : closed_embedding (comap f) :=
{ induced := (comap_inducing_of_surjective S f hf).induced,
  inj := comap_injective_of_surjective f hf,
  closed_range := is_closed_range_comap_of_surjective S f hf }

end spec_of_surjective

end comap

section basic_open

/-- `basic_open r` is the open subset containing all prime ideals not containing `r`. -/
def basic_open (r : R) : topological_space.opens (prime_spectrum R) :=
{ carrier := { x | r ∉ x.as_ideal },
  is_open' := ⟨{r}, set.ext $ λ x, set.singleton_subset_iff.trans $ not_not.symm⟩ }

@[simp] lemma mem_basic_open (f : R) (x : prime_spectrum R) :
  x ∈ basic_open f ↔ f ∉ x.as_ideal := iff.rfl

lemma is_open_basic_open {a : R} : is_open ((basic_open a) : set (prime_spectrum R)) :=
(basic_open a).is_open

@[simp] lemma basic_open_eq_zero_locus_compl (r : R) :
  (basic_open r : set (prime_spectrum R)) = (zero_locus {r})ᶜ :=
set.ext $ λ x, by simpa only [set.mem_compl_iff, mem_zero_locus, set.singleton_subset_iff]

@[simp] lemma basic_open_one : basic_open (1 : R) = ⊤ :=
topological_space.opens.ext $ by simp

@[simp] lemma basic_open_zero : basic_open (0 : R) = ⊥ :=
topological_space.opens.ext $ by simp

lemma basic_open_le_basic_open_iff (f g : R) :
  basic_open f ≤ basic_open g ↔ f ∈ (ideal.span ({g} : set R)).radical :=
by rw [← set_like.coe_subset_coe, basic_open_eq_zero_locus_compl,
    basic_open_eq_zero_locus_compl, set.compl_subset_compl,
    zero_locus_subset_zero_locus_singleton_iff]

lemma basic_open_mul (f g : R) : basic_open (f * g) = basic_open f ⊓ basic_open g :=
topological_space.opens.ext $ by {simp [zero_locus_singleton_mul]}

lemma basic_open_mul_le_left (f g : R) : basic_open (f * g) ≤ basic_open f :=
by { rw basic_open_mul f g, exact inf_le_left }

lemma basic_open_mul_le_right (f g : R) : basic_open (f * g) ≤ basic_open g :=
by { rw basic_open_mul f g, exact inf_le_right }

@[simp] lemma basic_open_pow (f : R) (n : ℕ) (hn : 0 < n) : basic_open (f ^ n) = basic_open f :=
topological_space.opens.ext $ by simpa using zero_locus_singleton_pow f n hn

lemma is_topological_basis_basic_opens : topological_space.is_topological_basis
  (set.range (λ (r : R), (basic_open r : set (prime_spectrum R)))) :=
begin
  apply topological_space.is_topological_basis_of_open_of_nhds,
  { rintros _ ⟨r, rfl⟩,
    exact is_open_basic_open },
  { rintros p U hp ⟨s, hs⟩,
    rw [← compl_compl U, set.mem_compl_iff, ← hs, mem_zero_locus, set.not_subset] at hp,
    obtain ⟨f, hfs, hfp⟩ := hp,
    refine ⟨basic_open f, ⟨f, rfl⟩, hfp, _⟩,
    rw [← set.compl_subset_compl, ← hs, basic_open_eq_zero_locus_compl, compl_compl],
    exact zero_locus_anti_mono (set.singleton_subset_iff.mpr hfs) }
end

lemma is_basis_basic_opens :
  topological_space.opens.is_basis (set.range (@basic_open R _)) :=
begin
  unfold topological_space.opens.is_basis,
  convert is_topological_basis_basic_opens,
  rw ← set.range_comp,
end

lemma is_compact_basic_open (f : R) : is_compact (basic_open f : set (prime_spectrum R)) :=
is_compact_of_finite_subfamily_closed $ λ ι Z hZc hZ,
begin
  let I : ι → ideal R := λ i, vanishing_ideal (Z i),
  have hI : ∀ i, Z i = zero_locus (I i) := λ i,
    by simpa only [zero_locus_vanishing_ideal_eq_closure] using (hZc i).closure_eq.symm,
  rw [basic_open_eq_zero_locus_compl f, set.inter_comm, ← set.diff_eq,
      set.diff_eq_empty, funext hI, ← zero_locus_supr] at hZ,
  obtain ⟨n, hn⟩ : f ∈ (⨆ (i : ι), I i).radical,
  { rw ← vanishing_ideal_zero_locus_eq_radical,
    apply vanishing_ideal_anti_mono hZ,
    exact (subset_vanishing_ideal_zero_locus {f} (set.mem_singleton f)) },
  rcases submodule.exists_finset_of_mem_supr I hn with ⟨s, hs⟩,
  use s,
  -- Using simp_rw here, because `hI` and `zero_locus_supr` need to be applied underneath binders
  simp_rw [basic_open_eq_zero_locus_compl f, set.inter_comm (zero_locus {f})ᶜ, ← set.diff_eq,
           set.diff_eq_empty, hI, ← zero_locus_supr],
  rw ← zero_locus_radical, -- this one can't be in `simp_rw` because it would loop
  apply zero_locus_anti_mono,
  rw set.singleton_subset_iff,
  exact ⟨n, hs⟩
end

@[simp]
lemma basic_open_eq_bot_iff (f : R) :
  basic_open f = ⊥ ↔ is_nilpotent f :=
begin
  rw [← topological_space.opens.coe_inj, basic_open_eq_zero_locus_compl],
  simp only [set.eq_univ_iff_forall, set.singleton_subset_iff,
    topological_space.opens.coe_bot, nilpotent_iff_mem_prime, set.compl_empty_iff, mem_zero_locus,
    set_like.mem_coe],
  exact ⟨λ h I hI, h ⟨I, hI⟩, λ h ⟨I, hI⟩, h I hI⟩
end

lemma localization_away_comap_range (S : Type v) [comm_ring S] [algebra R S] (r : R)
  [is_localization.away r S] : set.range (comap (algebra_map R S)) = basic_open r :=
begin
  rw localization_comap_range S (submonoid.powers r),
  ext,
  simp only [mem_zero_locus, basic_open_eq_zero_locus_compl, set_like.mem_coe, set.mem_set_of_eq,
    set.singleton_subset_iff, set.mem_compl_iff, disjoint_iff_inf_le],
  split,
  { intros h₁ h₂,
    exact h₁ ⟨submonoid.mem_powers r, h₂⟩ },
  { rintros h₁ _ ⟨⟨n, rfl⟩, h₃⟩,
    exact h₁ (x.2.mem_of_pow_mem _ h₃) },
end

lemma localization_away_open_embedding (S : Type v) [comm_ring S] [algebra R S] (r : R)
  [is_localization.away r S] : open_embedding (comap (algebra_map R S)) :=
{ to_embedding := localization_comap_embedding S (submonoid.powers r),
  open_range := by { rw localization_away_comap_range S r, exact is_open_basic_open } }

end basic_open

/-- The prime spectrum of a commutative ring is a compact topological space. -/
instance : compact_space (prime_spectrum R) :=
{ is_compact_univ := by { convert is_compact_basic_open (1 : R), rw basic_open_one, refl } }

section order

/-!
## The specialization order

We endow `prime_spectrum R` with a partial order, where `x ≤ y` if and only if `y ∈ closure {x}`.
-/

instance : partial_order (prime_spectrum R) := partial_order.lift as_ideal ext

@[simp] lemma as_ideal_le_as_ideal (x y : prime_spectrum R) : x.as_ideal ≤ y.as_ideal ↔ x ≤ y :=
iff.rfl

@[simp] lemma as_ideal_lt_as_ideal (x y : prime_spectrum R) : x.as_ideal < y.as_ideal ↔ x < y :=
iff.rfl

lemma le_iff_mem_closure (x y : prime_spectrum R) :
  x ≤ y ↔ y ∈ closure ({x} : set (prime_spectrum R)) :=
by rw [← as_ideal_le_as_ideal, ← zero_locus_vanishing_ideal_eq_closure,
    mem_zero_locus, vanishing_ideal_singleton, set_like.coe_subset_coe]

lemma le_iff_specializes (x y : prime_spectrum R) :
  x ≤ y ↔ x ⤳ y :=
(le_iff_mem_closure x y).trans specializes_iff_mem_closure.symm

/-- `nhds` as an order embedding. -/
@[simps { fully_applied := tt }]
def nhds_order_embedding : prime_spectrum R ↪o filter (prime_spectrum R) :=
order_embedding.of_map_le_iff nhds $ λ a b, (le_iff_specializes a b).symm

instance : t0_space (prime_spectrum R) := ⟨nhds_order_embedding.injective⟩

instance [is_domain R] : order_bot (prime_spectrum R) :=
{ bot := ⟨⊥, ideal.bot_prime⟩,
  bot_le := λ I, @bot_le _ _ _ I.as_ideal }

instance {R : Type*} [field R] : unique (prime_spectrum R) :=
{ default := ⊥,
  uniq := λ x, ext _ _ ((is_simple_order.eq_bot_or_eq_top _).resolve_right x.2.ne_top) }

end order

/-- If `x` specializes to `y`, then there is a natural map from the localization of `y` to the
localization of `x`. -/
def localization_map_of_specializes {x y : prime_spectrum R} (h : x ⤳ y) :
  localization.at_prime y.as_ideal →+* localization.at_prime x.as_ideal :=
@is_localization.lift _ _ _ _ _ _ _ _
  localization.is_localization (algebra_map R (localization.at_prime x.as_ideal))
  begin
    rintro ⟨a, ha⟩,
    rw [← prime_spectrum.le_iff_specializes, ← as_ideal_le_as_ideal, ← set_like.coe_subset_coe,
      ← set.compl_subset_compl] at h,
    exact (is_localization.map_units _ ⟨a, (show a ∈ x.as_ideal.prime_compl, from h ha)⟩ : _)
  end

end prime_spectrum

namespace local_ring

variables [local_ring R]

/-- The closed point in the prime spectrum of a local ring. -/
def closed_point : prime_spectrum R := ⟨maximal_ideal R, (maximal_ideal.is_maximal R).is_prime⟩

variable {R}

lemma is_local_ring_hom_iff_comap_closed_point {S : Type v} [comm_ring S] [local_ring S]
  (f : R →+* S) : is_local_ring_hom f ↔ prime_spectrum.comap f (closed_point S) = closed_point R :=
by { rw [(local_hom_tfae f).out 0 4, prime_spectrum.ext_iff], refl }

@[simp] lemma comap_closed_point {S : Type v} [comm_ring S] [local_ring S] (f : R →+* S)
  [is_local_ring_hom f] : prime_spectrum.comap f (closed_point S) = closed_point R :=
(is_local_ring_hom_iff_comap_closed_point f).mp infer_instance

lemma specializes_closed_point (x : prime_spectrum R) :
  x ⤳ closed_point R :=
(prime_spectrum.le_iff_specializes _ _).mp (local_ring.le_maximal_ideal x.2.1)

lemma closed_point_mem_iff (U : topological_space.opens $ prime_spectrum R) :
  closed_point R ∈ U ↔ U = ⊤ :=
begin
  split,
  { rw eq_top_iff, exact λ h x _, (specializes_closed_point x).mem_open U.2 h },
  { rintro rfl, trivial }
end

@[simp] lemma _root_.prime_spectrum.comap_residue (x : prime_spectrum (residue_field R)) :
  prime_spectrum.comap (residue R) x = closed_point R :=
begin
  rw subsingleton.elim x ⊥,
  ext1,
  exact ideal.mk_ker,
end

end local_ring


import FOL.fol

universe u

namespace fol
open term formula
variables {L : language.{u}}

def Theory.sf (T : Theory L) : Theory L := {p | ∃ q : formula L, q ∈ T ∧ p = q^1}

prefix `⤊`:max := Theory.sf

@[reducible] def Theory.sf_itr (T : Theory L) : ℕ → Theory L
| 0     := T
| (n+1) := ⤊(Theory.sf_itr n)

instance sf_itr_pow : has_pow (Theory L) ℕ := ⟨Theory.sf_itr⟩

@[simp] lemma Theory.sf_itr_0 (T : Theory L) : T^0 = T := rfl

lemma Theory.sf_itr_succ (T : Theory L) (n) : T^(n+1) = ⤊(T^n) := rfl

lemma Theory.pow_add (T : Theory L) (i j : ℕ) : (T^i)^j = T^(i + j) :=
by { induction j with j IH; simp[Theory.sf_itr_succ, ←nat.add_one, ←add_assoc], simp[IH] }

class closed_Theory (T : Theory L) := (cl : ∀ {p}, p ∈ T → is_sentence p)

attribute [simp] closed_Theory.cl

def proper_at (n : ℕ) (T : Theory L) : Prop := ∀ (p : formula L) (s), p ∈ T → p.rew (s^n) ∈ T

def proper_Theory'_at (n : ℕ) (T : Theory L) : Prop := ∀ (p : formula L) (s : ℕ → term L),
  p ∈ T → p.rew (λ x, if x < n then #x else s (x - n)) ∈ T

def ordered_p (T : Theory L) : Prop := ∀ (p : formula L), p ∈ T → p^1 ∈ T

class ordered (T : Theory L) := (ordered : ordered_p T)

lemma oedered_p_Theory_sf (T : Theory L) : ordered_p T → ordered_p ⤊T := λ h p hyp,
by { rcases hyp with ⟨p', hyp_p, rfl⟩, refine ⟨p'^1, _, rfl⟩, exact h _ hyp_p }

instance ordered_Theory_sf {T : Theory L} [od : ordered T] :
  ordered ⤊T := ⟨oedered_p_Theory_sf _ od.ordered⟩

instance ordered_Theory_sf_itr {T : Theory L} [od : ordered T] : ∀ n : ℕ, ordered (T^n)
| 0 := od
| (n+1) := @fol.ordered_Theory_sf _ _  (ordered_Theory_sf_itr n)

-- 自由変項の書き換えによって変化しない論理式の集合
class proper_Theory (T : Theory L) := (proper : ∀ (p : formula L) (s), p ∈ T → p.rew s ∈ T)

@[simp] lemma proper_Theory.rew_mem {T : Theory L} [proper_Theory T] {p : formula L} (h : p ∈ T) {s} :
  p.rew s ∈ T := proper_Theory.proper p s h

instance ordered_proper {T : Theory L} [proper_Theory T] : ordered T :=
⟨λ p h, proper_Theory.proper _ (λ x, #(x+1)) h⟩

lemma proper_Theory.proper0 {T : Theory L} [proper_Theory T] :
  ∀ {p : formula L} {s}, p ∈ T → p.rew s ∈ T := @proper_Theory.proper _ T _

instance : closed_Theory (∅ : Theory L) := ⟨λ _ h, by exfalso; exact h⟩

instance : proper_Theory (∅ : Theory L) := ⟨λ _ _ h, by exfalso; exact h⟩

instance : proper_Theory (set.univ : Theory L) := ⟨λ p s h, by simp⟩

def openform : Theory L := {p | p.is_open = tt}

instance : proper_Theory (openform : Theory L) :=
⟨λ p s h, by { induction p; simp[openform] at*; simp* at* }⟩

lemma Theory_sf_def {T : Theory L} :
  ⤊T = {p | ∃ q : formula L, q ∈ T ∧ p = q^1} :=
by { simp[Theory.sf] }

lemma Theory_sf_itr_eq {T : Theory L} : ∀ {i : ℕ},
  T^i = {p | ∃ q : formula L, q ∈ T ∧ p = q^i}
| 0      := by simp
| (i+1)  := by { simp[Theory.sf_itr_succ, @Theory_sf_itr_eq i, Theory.sf], ext p,
  simp, refine ⟨λ h, _, λ h, _⟩,
  { rcases h with ⟨q1, ⟨q2, h, rfl⟩, rfl⟩, refine ⟨q2, h, by simp[formula.pow_add]⟩ },
  { rcases h with ⟨q, h, rfl⟩, refine ⟨q^i, ⟨q, h, rfl⟩, by simp[formula.pow_add]⟩ } }

lemma sf_eq_image {T : Theory L} :
  ⤊T = (λ p, p^1) '' T :=
by { ext p, simp[Theory_sf_def], tauto }

lemma pow_eq_image {T : Theory L} {i : ℕ} :
  T^i = (λ p, p^i) '' T :=
by { ext p, simp[Theory_sf_itr_eq], tauto }

lemma is_sentence_mem_Theory_sf_itr {T : Theory L} {p : formula L} (a : is_sentence p) (n : ℕ) :
  p ∈ T → p ∈ T^n := λ h,
by { have : p.rew (λ x, #(x+n)) = p, exact formula.is_sentence_rew a _, rw ←this,
     simp[Theory_sf_itr_eq], refine ⟨p, h, rfl⟩ }

lemma proper_sf_inclusion (T : Theory L) [proper_Theory T] : ∀ {n m : ℕ} (h : n ≤ m),
  T^m ⊆ T^n :=
begin
  suffices : ∀ {n m : ℕ}, T^(n+m) ⊆ T^n,
  { intros n m eqn p hyp, have e : m = n + (m - n), exact (nat.add_sub_of_le eqn).symm,
    rw e at hyp,
    exact this hyp },
  intros n m p h,
  induction m with m IH, { exact h },
  { suffices : p ∈ T^(n + m), from IH this, simp[Theory_sf_itr_eq] at h ⊢, rcases h with ⟨q, h, rfl⟩,
    have : q^1 ∈ T, from @proper_Theory.proper _ T _ _ (λ x, #(x + 1)) h,
    refine ⟨q^1, this, _⟩,
    simp[formula.pow_add, formula.nested_rew, nat.succ_add_eq_succ_add, ←add_assoc] }
end

lemma ordered_inclusion (T : Theory L) [ordered T] : ⤊T ⊆ T := λ p h,
by { rcases h with ⟨p, hyp, rfl⟩, exact ordered.ordered _ hyp }

lemma proper_Theory_sf_itr {n : ℕ} {T : Theory L} (pp : proper_at n T) : ∀ m,
  proper_at (n+m) (T^m)
| 0     := by { simp, exact @pp }
| (m+1) := λ p s h, by { rcases h with ⟨p, hyp_p, rfl⟩, rw ←add_assoc,
     show (p^1).rew ((s^(n + m))^1) ∈ ⤊(T^m), simp[←formula.pow_rew_distrib],
     refine ⟨p.rew (s^(n+m)), proper_Theory_sf_itr m _ s hyp_p, rfl⟩ }

lemma properc_Theory_sf_itr {T : Theory L} [proper_Theory T] {n} :
  proper_at n (T^n) :=
by { have := proper_Theory_sf_itr (show proper_at 0 T, from proper_Theory.proper) n, simp at this, exact this}

lemma closed_proper {T : Theory L} [cl : closed_Theory T] : proper_at 0 T :=
λ p s h, by { simp[@closed_Theory.cl _ _ cl _ h], exact h }

@[simp] lemma closed_Theory_sf_eq {T : Theory L} [cl : closed_Theory T] : ⤊T = T :=
by { ext p, refine ⟨λ hyp, _, λ hyp, _⟩, rcases hyp with ⟨p, hyp_p, rfl⟩,
     simp[closed_Theory.cl hyp_p, hyp_p],
     rw ← (formula.is_sentence_sf (closed_Theory.cl hyp)), refine ⟨p, hyp, rfl⟩ }

@[simp] lemma closed_Theory_pow_eq (T : Theory L) [cl : closed_Theory T] (i : ℕ) : T^i = T :=
by { ext p, simp[Theory_sf_itr_eq], refine ⟨λ hyp, _, λ hyp, _⟩, rcases hyp with ⟨p, hyp_p, rfl⟩,
     simp[closed_Theory.cl hyp_p, hyp_p],
     rw ← (formula.is_sentence_sf (closed_Theory.cl hyp)), refine ⟨p, hyp, rfl⟩ }

lemma sf_dsb (T : Theory L) (p : formula L) : ⤊T +{ p^1 } = ⤊(T +{ p }) :=
begin
  ext x, split; intros h,
  { cases h with hx, refine ⟨p, by simp, hx⟩,
    rcases h with ⟨p', hp, rfl⟩, refine ⟨p', by simp[hp], rfl⟩ },
  { rcases h with ⟨q, hq, rfl⟩, rcases hq with (rfl | hq); simp,
    refine or.inr ⟨q, hq, rfl⟩ }
end

lemma pow_dsb (T : Theory L) (p : formula L) (k : ℕ) : (T +{ p })^k = (T^k) +{ p^k } :=
by induction k with k IH; simp[Theory.sf_itr_succ, ←sf_dsb, formula.pow_add, *]

lemma sf_union (T U : Theory L) : ⤊(T ∪ U) = ⤊T ∪ ⤊U :=
begin
  ext p, split,
  { rintros ⟨p, (mem | mem), rfl⟩,
    { refine or.inl _, refine ⟨p, mem, rfl⟩ },
    { refine or.inr _, refine ⟨p, mem, rfl⟩ } },
  { rintros (⟨p, mem, rfl⟩ | ⟨p, mem, rfl⟩),
    { refine ⟨p, or.inl mem, rfl⟩ },
    { refine ⟨p, or.inr mem, rfl⟩ } }
end

lemma pow_union (T U : Theory L) (k : ℕ) : (T ∪ U)^k = T^k ∪ U^k :=
by induction k with k IH; simp[←nat.add_one, Theory.sf_itr_succ, sf_union, *]

@[simp] lemma sf_ss {T U : Theory L} : ⤊T ⊆ ⤊U ↔ T ⊆ U :=
⟨λ h p mem, by {
  have : p^1 ∈ ⤊T, from ⟨p, mem, rfl⟩,
  rcases h this with ⟨q, h, eqn⟩, simp at eqn,
  simp[eqn, h] },
 λ h p, by { rintros ⟨p, mem, rfl⟩,
  refine ⟨p, h mem, rfl⟩ }⟩

@[simp] lemma pow_ss {T U : Theory L} {i : ℕ} : T^i ⊆ U^i ↔ T ⊆ U :=
by induction i with i; simp[←nat.add_one, Theory.sf_itr_succ, *]

instance union_closed (T U : Theory L) [closed_Theory T] [closed_Theory U] : closed_Theory (T ∪ U) :=
⟨λ p, by { simp, rintros (mem | mem), { exact closed_Theory.cl mem }, {  exact closed_Theory.cl mem } }⟩

end fol


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Jesse Michael Han
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.rcases
import Mathlib.data.sum
import Mathlib.logic.function.basic
import Mathlib.PostPort

universes r s u u_1

namespace Mathlib

/--
`derive_struct_ext_lemma n` generates two extensionality lemmas based on
the equality of all non-propositional projections.

On the following:

```lean
@[ext]
structure foo (α : Type*) :=
(x y : ℕ)
(z : {z // z < x})
(k : α)
(h : x < y)
```

`derive_struct_lemma` generates:

```lean
lemma foo.ext : ∀ {α : Type u_1} (x y : foo α),
  x.x = y.x → x.y = y.y → x.z == y.z → x.k = y.k → x = y
lemma foo.ext_iff : ∀ {α : Type u_1} (x y : foo α),
  x = y ↔ x.x = y.x ∧ x.y = y.y ∧ x.z == y.z ∧ x.k = y.k
```

-/
def ext_param_type :=
  Option name ⊕ Option name

/--
For performance reasons, it is inadvisable to use `user_attribute.get_param`.
The parameter is stored as a reflected expression.  When calling `get_param`,
the stored parameter is evaluated using `eval_expr`, which first compiles the
expression into VM bytecode. The unevaluated expression is available using
`user_attribute.get_param_untyped`.

In particular, `user_attribute.get_param` MUST NEVER BE USED in the
implementation of an attribute cache. This is because calling `eval_expr`
disables the attribute cache.

There are several possible workarounds:
 1. Set a different attribute depending on the parameter.
 2. Use your own evaluation function instead of `eval_expr`, such as e.g. `expr.to_nat`.
 3. Write your own `has_reflect Param` instance (using a more efficient serialization format).
   The `user_attribute` code unfortunately checks whether the expression has the correct type,
   but you can use `` `(id %%e : Param) `` to pretend that your expression `e` has type `Param`.
-/
/-!
For performance reasons, the parameters of the `@[ext]` attribute are stored
in two auxiliary attributes:
```lean
attribute [ext [thunk]] funext

-- is turned into

-- is turned into
attribute [_ext_core (@id name @funext)] thunk
attribute [_ext_lemma_core] funext
```

see Note [user attribute parameters]
-/

/-- Private attribute used to tag extensionality lemmas. -/
/--
Returns the extensionality lemmas in the environment, as a map from structure
name to lemma name.
-/
/--
Returns the extensionality lemmas in the environment, as a list of lemma names.
-/
/--
Tag lemmas of the form:

```lean
@[ext]
lemma my_collection.ext (a b : my_collection)
  (h : ∀ x, a.lookup x = b.lookup y) :
  a = b := ...
```

The attribute indexes extensionality lemma using the type of the
objects (i.e. `my_collection`) which it gets from the statement of
the lemma.  In some cases, the same lemma can be used to state the
extensionality of multiple types that are definitionally equivalent.

```lean
attribute [ext [(→),thunk,stream]] funext
```

Those parameters are cumulative. The following are equivalent:

```lean
attribute [ext [(→),thunk]] funext
attribute [ext [stream]] funext
```
and
```lean
attribute [ext [(→),thunk,stream]] funext
```

One removes type names from the list for one lemma with:
```lean
attribute [ext [-stream,-thunk]] funext
```

Also, the following:

```lean
@[ext]
lemma my_collection.ext (a b : my_collection)
  (h : ∀ x, a.lookup x = b.lookup y) :
  a = b := ...
```

is equivalent to

```lean
@[ext *]
lemma my_collection.ext (a b : my_collection)
  (h : ∀ x, a.lookup x = b.lookup y) :
  a = b := ...
```

This allows us specify type synonyms along with the type
that is referred to in the lemma statement.

```lean
@[ext [*,my_type_synonym]]
lemma my_collection.ext (a b : my_collection)
  (h : ∀ x, a.lookup x = b.lookup y) :
  a = b := ...
```

The `ext` attribute can be applied to a structure to generate its extensionality lemmas:

```lean
@[ext]
structure foo (α : Type*) :=
(x y : ℕ)
(z : {z // z < x})
(k : α)
(h : x < y)
```

will generate:

```lean
@[ext] lemma foo.ext : ∀ {α : Type u_1} (x y : foo α),
x.x = y.x → x.y = y.y → x.z == y.z → x.k = y.k → x = y
lemma foo.ext_iff : ∀ {α : Type u_1} (x y : foo α),
x = y ↔ x.x = y.x ∧ x.y = y.y ∧ x.z == y.z ∧ x.k = y.k
```

-/
/--
When possible, `ext` lemmas are stated without a full set of arguments. As an example, for bundled
homs `f`, `g`, and `of`, `f.comp of = g.comp of → f = g` is a better `ext` lemma than
`(∀ x, f (of x) = g (of x)) → f = g`, as the former allows a second type-specific extensionality
lemmas to be applied to `f.comp of = g.comp of`.
If the domain of `of` is `ℕ` or `ℤ` and `of` is a `ring_hom`, such a lemma could then make the goal
`f (of 1) = g (of 1)`.

For bundled morphisms, there is a `ext` lemma that always applies of the form
`(∀ x, ⇑f x = ⇑g x) → f = g`. When adding type-specific `ext` lemmas like the one above, we want
these to be tried first. This happens automatically since the type-specific lemmas are inevitably
defined later.
-/
-- We mark some existing extensionality lemmas.

-- We create some extensionality lemmas for existing structures.

theorem ulift.ext {α : Type s} (x : ulift α) (y : ulift α) (h : ulift.down x = ulift.down y) : x = y := sorry

namespace plift

-- This is stronger than the one generated automatically.

theorem ext {P : Prop} (a : plift P) (b : plift P) : a = b :=
  cases_on a fun (a : P) => cases_on b fun (b : P) => Eq.refl (up a)

end plift

-- Conservatively, we'll only add extensionality lemmas for `has_*` structures

-- as they become useful.

theorem has_zero.ext_iff {α : Type u} (x : HasZero α) (y : HasZero α) : x = y ↔ 0 = 0 := sorry

theorem unit.ext {x : Unit} {y : Unit} : x = y :=
  punit.cases_on x (punit.cases_on y (Eq.refl PUnit.unit))

theorem punit.ext {x : PUnit} {y : PUnit} : x = y :=
  punit.cases_on x (punit.cases_on y (Eq.refl PUnit.unit))

namespace tactic

/-- Helper structure for `ext` and `ext1`. `lemmas` keeps track of extensionality lemmas
  applied so far. -/
/-- Helper function for `try_intros`. Additionally populates the `trace_msg` field
  of `ext_state`. -/
/-- Try to introduce as many arguments as possible, using the given patterns to destruct the
  introduced variables. Returns the unused patterns. -/
/-- Apply one extensionality lemma, and destruct the arguments using the patterns
  in the ext_state. -/
/-- Apply multiple extensionality lemmas, destructing the arguments using the given patterns. -/
/-- Apply one extensionality lemma, and destruct the arguments using the given patterns.
  Returns the unused patterns. -/
/-- Apply multiple extensionality lemmas, destructing the arguments using the given patterns.
  `ext ps (some n)` applies at most `n` extensionality lemmas. Returns the unused patterns. -/
/--
`ext1 id` selects and apply one extensionality lemma (with attribute
`ext`), using `id`, if provided, to name a local constant
introduced by the lemma. If `id` is omitted, the local constant is
named automatically, as per `intro`. Placing a `?` after `ext1`
 (e.g. `ext1? i ⟨a,b⟩ : 3`) will display a sequence of tactic
applications that can replace the call to `ext1`.
-/
/--
- `ext` applies as many extensionality lemmas as possible;
- `ext ids`, with `ids` a list of identifiers, finds extentionality and applies them
  until it runs out of identifiers in `ids` to name the local constants.
- `ext` can also be given an `rcases` pattern in place of an identifier.
  This will destruct the introduced local constant.
- Placing a `?` after `ext` (e.g. `ext? i ⟨a,b⟩ : 3`) will display
  a sequence of tactic applications that can replace the call to `ext`.

When trying to prove:

```lean
α β : Type,
f g : α → set β
⊢ f = g
```

applying `ext x y` yields:

```lean
α β : Type,
f g : α → set β,
x : α,
y : β
⊢ y ∈ f x ↔ y ∈ f x
```

by applying functional extensionality and set extensionality.

When trying to prove:

```lean
α β γ : Type
f g : α × β → γ
⊢ f = g
```

applying `ext ⟨a, b⟩` yields:

```lean
α β γ : Type,
f g : α × β → γ,
a : α,
b : β
⊢ f (a, b) = g (a, b)
```

by applying functional extensionality and destructing the introduced pair.

In the previous example, applying `ext? ⟨a,b⟩` will produce the trace message:

```lean
Try this: apply funext, rintro ⟨a, b⟩
```

A maximum depth can be provided with `ext x y z : 3`.
-/
/--
* `ext1 id` selects and apply one extensionality lemma (with


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simplicial_complex.link
import combinatorics.simplicial_complex.subdivision

namespace affine
open set
variables {m n : ℕ} {E : Type*} [normed_group E] [normed_space ℝ E] {S : simplicial_complex E}
  {X Y : finset E} {A : set (finset E)} [semilattice_inf_bot (finset E)] [decidable_eq E]

def simplicial_complex.on_boundary (S : simplicial_complex E) (X : finset E) :
  Prop :=
∃ (Z ∈ S.faces), X ⊂ Z ∧ ∀ {Z'}, Z' ∈ S.faces → X ⊂ Z' → Z = Z'

def simplicial_complex.boundary (S : simplicial_complex E) :
  simplicial_complex E :=
simplicial_complex.of_surcomplex
  {X | ∃ Y ∈ S.faces, X ⊆ Y ∧ S.on_boundary Y}
  (λ X ⟨Y, hY, hXY, _⟩, S.down_closed hY hXY)
  (λ X W ⟨Y, hY, hXY, Z⟩ hWX, ⟨Y, hY, subset.trans hWX hXY, Z⟩)

lemma boundary_empty (hS : S.faces = ∅) :
  S.boundary.faces = ∅ :=
begin
  unfold simplicial_complex.boundary,
  simp,
  rw hS,
  simp,
end

lemma boundary_singleton_empty (hS : S.faces = {∅}) :
  S.boundary.faces = ∅ :=
begin
  ext X,
  unfold simplicial_complex.boundary simplicial_complex.on_boundary,
  simp,
  rw hS,
  rintro _ (rfl : _ = ∅) XY Y (rfl : _ = ∅) t,
  apply (t.2 (empty_subset _)).elim,
end

lemma boundary_subset :
  S.boundary.faces ⊆ S.faces :=
λ X ⟨Y, hY, hXY, _⟩, S.down_closed hY hXY

lemma mem_boundary_iff_subset_unique_facet :
  X ∈ S.boundary.faces ↔ ∃ {Y Z}, Y ∈ S.faces ∧ Z ∈ S.facets ∧ X ⊆ Y ∧ Y ⊂ Z ∧
  ∀ {Z'}, Z' ∈ S.faces → Y ⊂ Z' → Z = Z' :=
begin
  split,
  { rintro ⟨Y, hY, hXY, Z, hZ, hYZ, hZunique⟩,
    suffices hZ' : Z ∈ S.facets,
    { exact ⟨Y, Z, hY, hZ', hXY, hYZ, (λ Z', hZunique)⟩ },
    use hZ,
    rintro Z' hZ' hZZ',
    exact hZunique hZ' ⟨finset.subset.trans hYZ.1 hZZ',
      (λ hZ'Y, hYZ.2 (finset.subset.trans hZZ' hZ'Y))⟩ },
  { rintro ⟨Y, Z, hY, hZ, hXY, hYZ, hZunique⟩,
    refine ⟨Y, hY, hXY, Z, hZ.1, hYZ, λ Z', hZunique⟩ }
end

lemma facets_disjoint_boundary :
  disjoint S.facets S.boundary.faces :=
begin
  rintro X ⟨⟨hX, hXunique⟩, ⟨Y, hY, hXY, Z, hZ, hYZ, hZunique⟩⟩,
  apply hYZ.2,
  rw ← hXunique hZ (subset.trans hXY hYZ.1),
  exact hXY,
end

lemma boundary_facet_iff :
  X ∈ S.boundary.facets ↔ S.on_boundary X :=
begin
  split,
  { rintro ⟨⟨Y, hY, XY, Z, hZ, hYZ, hZunique⟩, hXmax⟩,
    refine ⟨Z, hZ, finset.ssubset_of_subset_of_ssubset XY hYZ, λ Z', _⟩,
    have hX' : Y ∈ S.boundary.faces,
    { refine ⟨_, hY, subset.refl _, _, hZ, hYZ, λ Z', hZunique⟩ },
    have hXX' := hXmax hX' XY,
    subst hXX',
    apply hZunique },
  { rintro ⟨Y, hY, hXY, hYunique⟩,
    refine ⟨⟨X, S.down_closed hY hXY.1, subset.refl _, _, hY, hXY, λ Y', hYunique⟩, _⟩,
    rintro V ⟨W, hW, hVW, Z, hZ, hWZ, hZunique⟩ hXV,
    apply finset.subset.antisymm hXV,
    classical,
    by_contra hVX,
    have := hYunique (S.down_closed hW hVW) ⟨hXV, hVX⟩,
    subst this,
    have := hYunique hZ ⟨subset.trans hXV (subset.trans hVW hWZ.1),
      λ hZX, hWZ.2 (subset.trans hZX (subset.trans hXV hVW))⟩,
    subst this,
    exact hWZ.2 hVW,
  }
end

lemma boundary_facet_iff' :
  X ∈ S.boundary.facets ↔ ∃ {Y}, Y ∈ S.facets ∧ X ⊂ Y ∧ ∀ {Y'}, Y' ∈ S.faces → X ⊂ Y' → Y = Y' :=
begin
  rw boundary_facet_iff,
  split,
  { rintro ⟨Y, hY, hXY, hYunique⟩,
    have hY' : Y ∈ S.facets,
    { use hY,
      rintro Y' hY' hYY',
      exact hYunique hY' (finset.ssubset_of_ssubset_of_subset hXY hYY'),
    },
    exact ⟨Y, hY', hXY, (λ Y', hYunique)⟩ },
  { rintro ⟨Y, hY, hXY, hYunique⟩,
    exact ⟨Y, hY.1, hXY, (λ Y', hYunique)⟩ }
end

lemma pure_boundary_of_pure (hS : S.pure_of n) :
  S.boundary.pure_of (n - 1) :=
begin
  rintro X hX,
  obtain ⟨Y, hY, hXY, hYunique⟩ := boundary_facet_iff'.1 hX,
  cases n,
  { apply nat.eq_zero_of_le_zero,
    have hYcard : Y.card = 0 := hS hY,
    rw ←hYcard,
    exact le_of_lt (finset.card_lt_card hXY) },
  have hYcard : Y.card = n.succ := hS hY,
  have hXcard : X.card ≤ n,
  { have := finset.card_lt_card hXY,
    rw hYcard at this,
    exact nat.le_of_lt_succ this },
  have : n - X.card + X.card ≤ Y.card,
  { rw [hS hY, nat.sub_add_cancel hXcard, nat.succ_eq_add_one],
    linarith },
  obtain ⟨W, hXW, hWY, hWcard⟩ := finset.exists_intermediate_set (n - X.card) this hXY.1,
  rw nat.sub_add_cancel hXcard at hWcard,
  have hW : W ∈ S.boundary.faces,
  { have hYW : ¬Y ⊆ W,
    { have hWYcard : W.card < Y.card,
      { rw [hWcard, hS hY, nat.succ_eq_add_one],
        linarith },rintro hYW,
      have : n.succ = n := by rw [← hS hY, ← hWcard,
        finset.eq_of_subset_of_card_le hYW (le_of_lt hWYcard)],
      exact nat.succ_ne_self n this },
    refine ⟨W, S.down_closed (facets_subset hY) hWY, subset.refl W, Y, hY.1, ⟨hWY, hYW⟩, _⟩,
    rintro Z hZ hWZ,
    exact hYunique hZ ⟨subset.trans hXW hWZ.1, (λ hZX, hWZ.2 (finset.subset.trans hZX hXW))⟩ },
  rw [nat.succ_sub_one, ←hWcard, hX.2 hW hXW],
end

lemma boundary_link :
  S.boundary.link A = (S.link A).boundary :=
begin
  ext V,
  split,
  {
    rintro ⟨hVdisj, W, X, hW, ⟨Y, Z, hY, hZ, hXY, hYZ, hZunique⟩, hVX, hWX⟩,
    use V,
    split,
    {
      sorry
      /-split,
      exact (λ U hU, hVdisj hU),
      exact ⟨W, Z, hW, facets_subset hZ, subset.trans hVX (subset.trans hXY hYZ.1),
        subset.trans hWX (subset.trans hXY hYZ.1)⟩,-/
    },
    {
      /-use subset.refl V,
      use Z,
      split,
      {
        sorry --waiting for link_facet_iff. May make this lemma require more assumptions
      },
      use ⟨finset.subset.trans hVX (finset.subset.trans hXY hYZ.1),
        (λ hZV, hYZ.2 (finset.subset.trans hZV (finset.subset.trans hVX hXY)))⟩,
      rintro U ⟨hUdisj, T, R, hT, hR, hUR, hTR⟩ hVU,
      apply hZunique (S.down_closed hR hUR),-/
      sorry
    }
  },
  {
    sorry
  }
end

lemma boundary_boundary [finite_dimensional ℝ E] (hS : S.pure_of n) (hS' : ∀ {X}, X ∈ S.faces →
  (X : finset E).card = n - 1 → equiv {Y | Y ∈ S.faces ∧ X ⊆ Y} (fin 2)) :
  S.boundary.boundary.faces = ∅ :=
begin
  rw ← facets_empty_iff_faces_empty,
  apply eq_empty_of_subset_empty,
  rintro V hV,
  obtain ⟨W, hW, hVW, hWunique⟩ := boundary_facet_iff'.1 hV,
  obtain ⟨X, hX, hXV, hXunique⟩ := boundary_facet_iff'.1 hW,
  sorry
end

lemma boundary_mono {S₁ S₂ : simplicial_complex E} (hS : S₁ ≤ S₂) :
  S₁.boundary ≤ S₂.boundary :=
begin
  /-cases S₂.faces.eq_empty_or_nonempty with hS₂empty hS₂nonempty,
  {
    rw hS₂empty,
  },
  rw subdivision_iff_partition at ⊢ hS,-/
  have hspace : S₁.boundary.space = S₂.boundary.space,
  {
    sorry
  },
  /-rw subdivision_iff_partition,
  split,
  {
    sorry
  },
  use le_of_eq hspace,
  rintro X₂ ⟨Y₂, Z₂, hY₂, hZ₂, hX₂Y₂, hY₂Z₂, hZ₂max⟩,
  obtain ⟨hempty, hspace, hpartition⟩ := subdivision_iff_partition.1 hS,
  obtain ⟨F, hF, hX₂F⟩ := hpartition (S₂.down_closed hY₂ hX₂Y₂),
  use F, rw and.comm, use hX₂F,
  rintro X₁ hX₁,-/

  use hspace,
  rintro X₁ ⟨Y₁, hY₁, hX₁Y₁, Z₁, hZ₁, hY₁Z₁, hZ₁max⟩,
  cases X₁.eq_empty_or_nonempty with hX₁empty hX₁nonempty,
  {
    sorry},
  obtain ⟨X₂, hX₂, hX₁X₂⟩ := (subdivision_iff_combi_interiors_subset_combi_interiors.1 hS).2
    (S₁.down_closed hY₁ hX₁Y₁),
  obtain ⟨Y₂, hY₂, hY₁Y₂⟩ := (subdivision_iff_combi_interiors_subset_combi_interiors.1 hS).2 hY₁,
  obtain ⟨Z₂, hZ₂, hZ₁Z₂⟩ := (subdivision_iff_combi_interiors_subset_combi_interiors.1 hS).2 hZ₁,
  obtain ⟨x, hxX₁⟩ := id hX₁nonempty,
  refine ⟨X₂, ⟨Y₂, hY₂, _, Z₂, hZ₂, ⟨_, _⟩⟩,
    convex_hull_subset_convex_hull_of_combi_interior_subset_combi_interior
    (S₁.indep (S₁.down_closed hY₁ hX₁Y₁)) (S₂.indep hX₂) hX₁X₂⟩,
  { apply subset_of_combi_interior_inter_convex_hull_nonempty hX₂ hY₂,
    obtain ⟨x, hxX₁⟩ := nonempty_combi_interior_of_nonempty (S₁.indep (S₁.down_closed hY₁ hX₁Y₁))
      hX₁nonempty,
    use [x, hX₁X₂ hxX₁],
    apply convex_hull_subset_convex_hull_of_combi_interior_subset_combi_interior (S₁.indep hY₁)
      (S₂.indep hY₂) hY₁Y₂,
    exact convex_hull_mono hX₁Y₁ hxX₁.1 },
  { obtain ⟨y, hyY₁⟩ := nonempty_combi_interior_of_nonempty (S₁.indep hY₁) ⟨x, hX₁Y₁ hxX₁⟩,
    split,
    { apply subset_of_combi_interior_inter_convex_hull_nonempty hY₂ hZ₂,
      use [y, hY₁Y₂ hyY₁],
      apply convex_hull_subset_convex_hull_of_combi_interior_subset_combi_interior (S₁.indep hZ₁)
        (S₂.indep hZ₂) hZ₁Z₂,
      exact convex_hull_mono hY₁Z₁.1 hyY₁.1 },
    { rintro hZ₂Y₂,
      suffices hY₂Z₂ : ¬Y₂ ⊆ Z₂,
      { apply (hY₁Y₂ hyY₁).2,
        rw mem_combi_frontier_iff,
        use [Z₂, ⟨hZ₂Y₂, hY₂Z₂⟩],
        apply convex_hull_subset_convex_hull_of_combi_interior_subset_combi_interior (S₁.indep hZ₁)
          (S₂.indep hZ₂) hZ₁Z₂,
        exact convex_hull_mono hY₁Z₁.1 hyY₁.1 },
      rintro hY₂Z₂,
      have := finset.subset.antisymm hY₂Z₂ hZ₂Y₂,
      subst this,
      suffices h : Y₁.card = Y₂.card,
      { have := finset.card_lt_card hY₁Z₁,
        have := card_le_of_convex_hull_subset (S₁.indep hZ₁)
          (convex_hull_subset_convex_hull_of_combi_interior_subset_combi_interior (S₁.indep hZ₁)
          (S₂.indep hY₂) hZ₁Z₂),
        linarith },

      sorry
    },
  },
  {
    rintro Z' hZ' hY₂Z',
    suffices hZ₁Z' : combi_interior Z₁ ⊆ combi_interior Z',
    {
      obtain ⟨z, hzZ₁⟩ := nonempty_combi_interior_of_nonempty (S₁.indep hZ₁) ⟨x, hY₁Z₁.1 (hX₁Y₁ hxX₁)⟩,
      exact disjoint_interiors hZ₂ hZ' (hZ₁Z₂ hzZ₁) (hZ₁Z' hzZ₁),
    },

    sorry
  }
end

--other attempt using subdivision_iff_partition
lemma boundary_mono' {S₁ S₂ : simplicial_complex E} (hS : S₁ ≤ S₂) :
  S₁.boundary ≤ S₂.boundary :=
begin
  rw subdivision_iff_partition,
  obtain ⟨hempty, hspace, hpartition⟩ := subdivision_iff_partition.1 hS,
  split,
  sorry,
  split,
  sorry,
  rintro X₂ hX₂,--rintro X₂ ⟨Y₂, hY₂, hX₂Y₂, Z₂, hZ₂, hY₂Z₂, hZ₂max⟩,
  obtain ⟨F, hF, hXF⟩ := hpartition (boundary_subset hX₂),--obtain ⟨F, hF, hXF⟩ := hpartition (S₂.down_closed hY₂ hX₂Y₂),
  use F,
  rw and.comm,
  use hXF,
  rintro X₁ hX₁,
  have hX₁X₂ : combi_interior X₁ ⊆ combi_interior X₂,
  { rw hXF,
    exact subset_bUnion_of_mem hX₁ },
  sorry
end

/--
A m-simplex is on the boundary of a full dimensional complex iff it belongs to exactly one cell.
Dull?
-/
lemma boundary_subcell_iff_one_surface (hS : S.full_dimensional) (hXcard : X.card = finite_dimensional.finrank ℝ E) :
  X ∈ S.boundary.faces ↔ nat.card {Y | Y ∈ S.faces ∧ X ⊂ Y} = 1 :=
  -- It's probably a bad idea to use `nat.card` since it's incredibly underdeveloped for doing
  -- actual maths in
  -- Does this lemma need you to assume locally finite (at X)? If so, the set you care about is a
  -- subset of the set we know is finite, so we can convert to a finset and use normal card
begin
  split,
  {
    rintro ⟨Y, hY, hXY, Z, hZ, hYZ, hZunique⟩,
    have : X = Y,
    {
      sorry
    },
    sorry--rw nat.card_eq_fintype_card,
  },
  -- have aux_lemma : ∀ {a b : E}, a ≠ b → a ∉ X → b ∉ X → X ∪ {a} ∈ S.faces → X ∪ {b} ∈ S.faces →
  --   ∃ w : E → ℝ, w a < 0 ∧ ∑ y in X ∪ {a}, w y = 1 ∧ (X ∪ {a}).center_mass w id = b,
  -- {
  --   sorry
  -- },
  sorry
end

/--
A m-simplex is not on the boundary of a full dimensional complex iff it belongs to exactly two
cells.
-/
lemma not_boundary_subcell_iff_two_surfaces (hS : S.full_dimensional) (hXcard : X.card = finite_dimensional.finrank ℝ E) :
  X ∉ S.boundary.faces ↔ nat.card {Y | Y ∈ S.faces ∧ X ⊂ Y} = 2 :=
  -- It's probably a bad idea to use `nat.card` since it's incredibly underdeveloped for doing
  -- actual maths in
  -- Does this lemma need you to assume locally finite (at X)? If so, the set you care about is a
  -- subset of the set we know is finite, so we can convert to a finset and use normal card
begin
  -- have aux_lemma : ∀ {a b : E}, a ≠ b → a ∉ X → b ∉ X → X ∪ {a} ∈ S.faces → X ∪ {b} ∈ S.faces →
  --   ∃ w : E → ℝ, w a < 0 ∧ ∑ y in X ∪ {a}, w y = 1 ∧ (X ∪ {a}).center_mass w id = b,
  -- {
  --   sorry
  -- },
  sorry
end

end affine