/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro, Johannes Hölzl, Sander Dahmen
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.basis
import Mathlib.set_theory.cardinal_ordinal
import Mathlib.PostPort

universes u v w w' m v' u_1 u₁ u₁' v''

namespace Mathlib

/-!
# Dimension of modules and vector spaces

## Main definitions

* The dimension of a vector space is defined as `vector_space.dim : cardinal`.

## Main statements

* `mk_eq_mk_of_basis`: the dimension theorem, any two bases of the same vector space have the same
  cardinality.
* `dim_quotient_add_dim`: if V₁ is a submodule of V, then dim (V/V₁) + dim V₁ = dim V.
* `dim_range_add_dim_ker`: the rank-nullity theorem.

## Implementation notes

Many theorems in this file are not universe-generic when they relate dimensions
in different universes. They should be as general as they can be without
inserting `lift`s. The types `V`, `V'`, ... all live in different universes,
and `V₁`, `V₂`, ... all live in the same universe.
-/

/-- the dimension of a vector space, defined as a term of type `cardinal` -/
def vector_space.dim (K : Type u) (V : Type v) [field K] [add_comm_group V] [vector_space K V] :
    cardinal :=
  cardinal.min sorry
    fun (b : Subtype fun (b : set V) => is_basis K fun (i : ↥b) => ↑i) =>
      cardinal.mk ↥(subtype.val b)

theorem is_basis.le_span {K : Type u} {V : Type v} {ι : Type w} [field K] [add_comm_group V]
    [vector_space K V] {v : ι → V} {J : set V} (hv : is_basis K v) (hJ : submodule.span K J = ⊤) :
    cardinal.mk ↥(set.range v) ≤ cardinal.mk ↥J :=
  sorry

/-- dimension theorem -/
theorem mk_eq_mk_of_basis {K : Type u} {V : Type v} {ι : Type w} {ι' : Type w'} [field K]
    [add_comm_group V] [vector_space K V] {v : ι → V} {v' : ι' → V} (hv : is_basis K v)
    (hv' : is_basis K v') : cardinal.lift (cardinal.mk ι) = cardinal.lift (cardinal.mk ι') :=
  sorry

theorem mk_eq_mk_of_basis' {K : Type u} {V : Type v} {ι : Type w} [field K] [add_comm_group V]
    [vector_space K V] {ι' : Type w} {v : ι → V} {v' : ι' → V} (hv : is_basis K v)
    (hv' : is_basis K v') : cardinal.mk ι = cardinal.mk ι' :=
  iff.mp cardinal.lift_inj (mk_eq_mk_of_basis hv hv')

theorem is_basis.mk_eq_dim'' {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] {ι : Type v} {v : ι → V} (h : is_basis K v) :
    cardinal.mk ι = vector_space.dim K V :=
  sorry

theorem is_basis.mk_range_eq_dim {K : Type u} {V : Type v} {ι : Type w} [field K] [add_comm_group V]
    [vector_space K V] {v : ι → V} (h : is_basis K v) :
    cardinal.mk ↥(set.range v) = vector_space.dim K V :=
  is_basis.mk_eq_dim'' (is_basis.range h)

theorem is_basis.mk_eq_dim {K : Type u} {V : Type v} {ι : Type w} [field K] [add_comm_group V]
    [vector_space K V] {v : ι → V} (h : is_basis K v) :
    cardinal.lift (cardinal.mk ι) = cardinal.lift (vector_space.dim K V) :=
  sorry

theorem is_basis.mk_eq_dim' {K : Type u} {V : Type v} {ι : Type w} [field K] [add_comm_group V]
    [vector_space K V] {v : ι → V} (h : is_basis K v) :
    cardinal.lift (cardinal.mk ι) = cardinal.lift (vector_space.dim K V) :=
  eq.mpr (id (propext cardinal.lift_max))
    (eq.mp (Eq.refl (cardinal.lift (cardinal.mk ι) = cardinal.lift (vector_space.dim K V)))
      (is_basis.mk_eq_dim h))

theorem dim_le {K : Type u} {V : Type v} [field K] [add_comm_group V] [vector_space K V] {n : ℕ}
    (H : ∀ (s : finset V), (linear_independent K fun (i : ↥↑s) => ↑i) → finset.card s ≤ n) :
    vector_space.dim K V ≤ ↑n :=
  sorry

/-- Two linearly equivalent vector spaces have the same dimension, a version with different
universes. -/
theorem linear_equiv.lift_dim_eq {K : Type u} {V : Type v} {V' : Type v'} [field K]
    [add_comm_group V] [vector_space K V] [add_comm_group V'] [vector_space K V']
    (f : linear_equiv K V V') :
    cardinal.lift (vector_space.dim K V) = cardinal.lift (vector_space.dim K V') :=
  sorry

/-- Two linearly equivalent vector spaces have the same dimension. -/
theorem linear_equiv.dim_eq {K : Type u} {V : Type v} {V₁ : Type v} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V₁] [vector_space K V₁] (f : linear_equiv K V V₁) :
    vector_space.dim K V = vector_space.dim K V₁ :=
  iff.mp cardinal.lift_inj (linear_equiv.lift_dim_eq f)

/-- Two vector spaces are isomorphic if they have the same dimension. -/
theorem nonempty_linear_equiv_of_lift_dim_eq {K : Type u} {V : Type v} {V' : Type v'} [field K]
    [add_comm_group V] [vector_space K V] [add_comm_group V'] [vector_space K V']
    (cond : cardinal.lift (vector_space.dim K V) = cardinal.lift (vector_space.dim K V')) :
    Nonempty (linear_equiv K V V') :=
  sorry

/-- Two vector spaces are isomorphic if they have the same dimension. -/
theorem nonempty_linear_equiv_of_dim_eq {K : Type u} {V : Type v} {V₁ : Type v} [field K]
    [add_comm_group V] [vector_space K V] [add_comm_group V₁] [vector_space K V₁]
    (cond : vector_space.dim K V = vector_space.dim K V₁) : Nonempty (linear_equiv K V V₁) :=
  nonempty_linear_equiv_of_lift_dim_eq (congr_arg cardinal.lift cond)

/-- Two vector spaces are isomorphic if they have the same dimension. -/
def linear_equiv.of_lift_dim_eq {K : Type u} (V : Type v) (V' : Type v') [field K]
    [add_comm_group V] [vector_space K V] [add_comm_group V'] [vector_space K V']
    (cond : cardinal.lift (vector_space.dim K V) = cardinal.lift (vector_space.dim K V')) :
    linear_equiv K V V' :=
  Classical.choice (nonempty_linear_equiv_of_lift_dim_eq cond)

/-- Two vector spaces are isomorphic if they have the same dimension. -/
def linear_equiv.of_dim_eq {K : Type u} (V : Type v) (V₁ : Type v) [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V₁] [vector_space K V₁]
    (cond : vector_space.dim K V = vector_space.dim K V₁) : linear_equiv K V V₁ :=
  Classical.choice (nonempty_linear_equiv_of_dim_eq cond)

/-- Two vector spaces are isomorphic if and only if they have the same dimension. -/
theorem linear_equiv.nonempty_equiv_iff_lift_dim_eq {K : Type u} {V : Type v} {V' : Type v'}
    [field K] [add_comm_group V] [vector_space K V] [add_comm_group V'] [vector_space K V'] :
    Nonempty (linear_equiv K V V') ↔
        cardinal.lift (vector_space.dim K V) = cardinal.lift (vector_space.dim K V') :=
  sorry

/-- Two vector spaces are isomorphic if and only if they have the same dimension. -/
theorem linear_equiv.nonempty_equiv_iff_dim_eq {K : Type u} {V : Type v} {V₁ : Type v} [field K]
    [add_comm_group V] [vector_space K V] [add_comm_group V₁] [vector_space K V₁] :
    Nonempty (linear_equiv K V V₁) ↔ vector_space.dim K V = vector_space.dim K V₁ :=
  sorry

@[simp] theorem dim_bot {K : Type u} {V : Type v} [field K] [add_comm_group V] [vector_space K V] :
    vector_space.dim K ↥⊥ = 0 :=
  sorry

@[simp] theorem dim_top {K : Type u} {V : Type v} [field K] [add_comm_group V] [vector_space K V] :
    vector_space.dim K ↥⊤ = vector_space.dim K V :=
  linear_equiv.dim_eq (linear_equiv.of_top ⊤ rfl)

theorem dim_of_field (K : Type u_1) [field K] : vector_space.dim K K = 1 := sorry

theorem dim_span {K : Type u} {V : Type v} {ι : Type w} [field K] [add_comm_group V]
    [vector_space K V] {v : ι → V} (hv : linear_independent K v) :
    vector_space.dim K ↥(submodule.span K (set.range v)) = cardinal.mk ↥(set.range v) :=
  sorry

theorem dim_span_set {K : Type u} {V : Type v} [field K] [add_comm_group V] [vector_space K V]
    {s : set V} (hs : linear_independent K fun (x : ↥s) => ↑x) :
    vector_space.dim K ↥(submodule.span K s) = cardinal.mk ↥s :=
  sorry

theorem cardinal_lift_le_dim_of_linear_independent {K : Type u} {V : Type v} [field K]
    [add_comm_group V] [vector_space K V] {ι : Type w} {v : ι → V} (hv : linear_independent K v) :
    cardinal.lift (cardinal.mk ι) ≤ cardinal.lift (vector_space.dim K V) :=
  sorry

theorem cardinal_le_dim_of_linear_independent {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] {ι : Type v} {v : ι → V} (hv : linear_independent K v) :
    cardinal.mk ι ≤ vector_space.dim K V :=
  eq.mpr (id (Eq.refl (cardinal.mk ι ≤ vector_space.dim K V)))
    (eq.mp (propext cardinal.lift_le) (cardinal_lift_le_dim_of_linear_independent hv))

theorem cardinal_le_dim_of_linear_independent' {K : Type u} {V : Type v} [field K]
    [add_comm_group V] [vector_space K V] {s : set V}
    (hs : linear_independent K fun (x : ↥s) => ↑x) : cardinal.mk ↥s ≤ vector_space.dim K V :=
  sorry

theorem dim_span_le {K : Type u} {V : Type v} [field K] [add_comm_group V] [vector_space K V]
    (s : set V) : vector_space.dim K ↥(submodule.span K s) ≤ cardinal.mk ↥s :=
  sorry

theorem dim_span_of_finset {K : Type u} {V : Type v} [field K] [add_comm_group V] [vector_space K V]
    (s : finset V) : vector_space.dim K ↥(submodule.span K ↑s) < cardinal.omega :=
  sorry

theorem dim_prod {K : Type u} {V : Type v} {V₁ : Type v} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V₁] [vector_space K V₁] :
    vector_space.dim K (V × V₁) = vector_space.dim K V + vector_space.dim K V₁ :=
  sorry

theorem dim_quotient_add_dim {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] (p : submodule K V) :
    vector_space.dim K (submodule.quotient p) + vector_space.dim K ↥p = vector_space.dim K V :=
  sorry

theorem dim_quotient_le {K : Type u} {V : Type v} [field K] [add_comm_group V] [vector_space K V]
    (p : submodule K V) : vector_space.dim K (submodule.quotient p) ≤ vector_space.dim K V :=
  sorry

/-- rank-nullity theorem -/
theorem dim_range_add_dim_ker {K : Type u} {V : Type v} {V₁ : Type v} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V₁] [vector_space K V₁] (f : linear_map K V V₁) :
    vector_space.dim K ↥(linear_map.range f) + vector_space.dim K ↥(linear_map.ker f) =
        vector_space.dim K V :=
  sorry

theorem dim_range_le {K : Type u} {V : Type v} {V₁ : Type v} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V₁] [vector_space K V₁] (f : linear_map K V V₁) :
    vector_space.dim K ↥(linear_map.range f) ≤ vector_space.dim K V :=
  sorry

theorem dim_map_le {K : Type u} {V : Type v} {V₁ : Type v} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V₁] [vector_space K V₁] (f : linear_map K V V₁)
    (p : submodule K V) : vector_space.dim K ↥(submodule.map f p) ≤ vector_space.dim K ↥p :=
  sorry

theorem dim_range_of_surjective {K : Type u} {V : Type v} {V' : Type v'} [field K]
    [add_comm_group V] [vector_space K V] [add_comm_group V'] [vector_space K V']
    (f : linear_map K V V') (h : function.surjective ⇑f) :
    vector_space.dim K ↥(linear_map.range f) = vector_space.dim K V' :=
  sorry

theorem dim_eq_of_surjective {K : Type u} {V : Type v} {V₁ : Type v} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V₁] [vector_space K V₁] (f : linear_map K V V₁)
    (h : function.surjective ⇑f) :
    vector_space.dim K V = vector_space.dim K V₁ + vector_space.dim K ↥(linear_map.ker f) :=
  sorry

theorem dim_le_of_surjective {K : Type u} {V : Type v} {V₁ : Type v} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V₁] [vector_space K V₁] (f : linear_map K V V₁)
    (h : function.surjective ⇑f) : vector_space.dim K V₁ ≤ vector_space.dim K V :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (vector_space.dim K V₁ ≤ vector_space.dim K V))
        (dim_eq_of_surjective f h)))
    (self_le_add_right (vector_space.dim K V₁) (vector_space.dim K ↥(linear_map.ker f)))

theorem dim_eq_of_injective {K : Type u} {V : Type v} {V₁ : Type v} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V₁] [vector_space K V₁] (f : linear_map K V V₁)
    (h : function.injective ⇑f) : vector_space.dim K V = vector_space.dim K ↥(linear_map.range f) :=
  sorry

theorem dim_submodule_le {K : Type u} {V : Type v} [field K] [add_comm_group V] [vector_space K V]
    (s : submodule K V) : vector_space.dim K ↥s ≤ vector_space.dim K V :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (vector_space.dim K ↥s ≤ vector_space.dim K V))
        (Eq.symm (dim_quotient_add_dim s))))
    (self_le_add_left (vector_space.dim K ↥s) (vector_space.dim K (submodule.quotient s)))

theorem dim_le_of_injective {K : Type u} {V : Type v} {V₁ : Type v} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V₁] [vector_space K V₁] (f : linear_map K V V₁)
    (h : function.injective ⇑f) : vector_space.dim K V ≤ vector_space.dim K V₁ :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (vector_space.dim K V ≤ vector_space.dim K V₁))
        (dim_eq_of_injective f h)))
    (dim_submodule_le (linear_map.range f))

theorem dim_le_of_submodule {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] (s : submodule K V) (t : submodule K V) (h : s ≤ t) :
    vector_space.dim K ↥s ≤ vector_space.dim K ↥t :=
  sorry

theorem linear_independent_le_dim {K : Type u} {V : Type v} {ι : Type w} [field K]
    [add_comm_group V] [vector_space K V] {v : ι → V} (hv : linear_independent K v) :
    cardinal.lift (cardinal.mk ι) ≤ cardinal.lift (vector_space.dim K V) :=
  sorry

theorem linear_independent_le_dim' {K : Type u} {V : Type v} {ι : Type w} [field K]
    [add_comm_group V] [vector_space K V] {v : ι → V} (hs : linear_independent K v) :
    cardinal.lift (cardinal.mk ι) ≤ cardinal.lift (vector_space.dim K V) :=
  cardinal.mk_range_eq_lift (linear_independent.injective hs) ▸
    dim_span hs ▸ iff.mpr cardinal.lift_le (dim_submodule_le (submodule.span K (set.range v)))

/-- This is mostly an auxiliary lemma for `dim_sup_add_dim_inf_eq`. -/
theorem dim_add_dim_split {K : Type u} {V : Type v} {V₁ : Type v} {V₂ : Type v} {V₃ : Type v}
    [field K] [add_comm_group V] [vector_space K V] [add_comm_group V₁] [vector_space K V₁]
    [add_comm_group V₂] [vector_space K V₂] [add_comm_group V₃] [vector_space K V₃]
    (db : linear_map K V₂ V) (eb : linear_map K V₃ V) (cd : linear_map K V₁ V₂)
    (ce : linear_map K V₁ V₃) (hde : ⊤ ≤ linear_map.range db ⊔ linear_map.range eb)
    (hgd : linear_map.ker cd = ⊥) (eq : linear_map.comp db cd = linear_map.comp eb ce)
    (eq₂ :
      ∀ (d : V₂) (e : V₃),
        coe_fn db d = coe_fn eb e → ∃ (c : V₁), coe_fn cd c = d ∧ coe_fn ce c = e) :
    vector_space.dim K V + vector_space.dim K V₁ = vector_space.dim K V₂ + vector_space.dim K V₃ :=
  sorry

theorem dim_sup_add_dim_inf_eq {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] (s : submodule K V) (t : submodule K V) :
    vector_space.dim K ↥(s ⊔ t) + vector_space.dim K ↥(s ⊓ t) =
        vector_space.dim K ↥s + vector_space.dim K ↥t :=
  sorry

theorem dim_add_le_dim_add_dim {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] (s : submodule K V) (t : submodule K V) :
    vector_space.dim K ↥(s ⊔ t) ≤ vector_space.dim K ↥s + vector_space.dim K ↥t :=
  sorry

theorem dim_pi {K : Type u} {η : Type u₁'} {φ : η → Type u_1} [field K] [fintype η]
    [(i : η) → add_comm_group (φ i)] [(i : η) → vector_space K (φ i)] :
    vector_space.dim K ((i : η) → φ i) = cardinal.sum fun (i : η) => vector_space.dim K (φ i) :=
  sorry

theorem dim_fun {K : Type u} [field K] {V : Type u} {η : Type u} [fintype η] [add_comm_group V]
    [vector_space K V] : vector_space.dim K (η → V) = ↑(fintype.card η) * vector_space.dim K V :=
  sorry

theorem dim_fun_eq_lift_mul {K : Type u} {V : Type v} {η : Type u₁'} [field K] [add_comm_group V]
    [vector_space K V] [fintype η] :
    vector_space.dim K (η → V) = ↑(fintype.card η) * cardinal.lift (vector_space.dim K V) :=
  sorry

theorem dim_fun' {K : Type u} {η : Type u₁'} [field K] [fintype η] :
    vector_space.dim K (η → K) = ↑(fintype.card η) :=
  sorry

theorem dim_fin_fun {K : Type u} [field K] (n : ℕ) : vector_space.dim K (fin n → K) = ↑n := sorry

theorem exists_mem_ne_zero_of_ne_bot {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] {s : submodule K V} (h : s ≠ ⊥) : ∃ (b : V), b ∈ s ∧ b ≠ 0 :=
  sorry

theorem exists_mem_ne_zero_of_dim_pos {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] {s : submodule K V} (h : 0 < vector_space.dim K ↥s) :
    ∃ (b : V), b ∈ s ∧ b ≠ 0 :=
  sorry

theorem exists_is_basis_fintype {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] (h : vector_space.dim K V < cardinal.omega) :
    ∃ (s : set V), is_basis K subtype.val ∧ Nonempty (fintype ↥s) :=
  sorry

/-- `rank f` is the rank of a `linear_map f`, defined as the dimension of `f.range`. -/
def rank {K : Type u} {V : Type v} {V' : Type v'} [field K] [add_comm_group V] [vector_space K V]
    [add_comm_group V'] [vector_space K V'] (f : linear_map K V V') : cardinal :=
  vector_space.dim K ↥(linear_map.range f)

theorem rank_le_domain {K : Type u} {V : Type v} {V₁ : Type v} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V₁] [vector_space K V₁] (f : linear_map K V V₁) :
    rank f ≤ vector_space.dim K V :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (rank f ≤ vector_space.dim K V)) (Eq.symm (dim_range_add_dim_ker f))))
    (self_le_add_right (rank f) (vector_space.dim K ↥(linear_map.ker f)))

theorem rank_le_range {K : Type u} {V : Type v} {V₁ : Type v} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V₁] [vector_space K V₁] (f : linear_map K V V₁) :
    rank f ≤ vector_space.dim K V₁ :=
  dim_submodule_le (linear_map.range f)

theorem rank_add_le {K : Type u} {V : Type v} {V' : Type v'} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V'] [vector_space K V'] (f : linear_map K V V')
    (g : linear_map K V V') : rank (f + g) ≤ rank f + rank g :=
  sorry

@[simp] theorem rank_zero {K : Type u} {V : Type v} {V' : Type v'} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V'] [vector_space K V'] : rank 0 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (rank 0 = 0)) (rank.equations._eqn_1 0)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (vector_space.dim K ↥(linear_map.range 0) = 0)) linear_map.range_zero))
      (eq.mpr (id (Eq._oldrec (Eq.refl (vector_space.dim K ↥⊥ = 0)) dim_bot)) (Eq.refl 0)))

theorem rank_finset_sum_le {K : Type u} {V : Type v} {V' : Type v'} [field K] [add_comm_group V]
    [vector_space K V] [add_comm_group V'] [vector_space K V'] {η : Type u_1} (s : finset η)
    (f : η → linear_map K V V') :
    rank (finset.sum s fun (d : η) => f d) ≤ finset.sum s fun (d : η) => rank (f d) :=
  finset.sum_hom_rel (le_of_eq rank_zero)
    fun (i : η) (g : linear_map K V V') (c : cardinal) (h : rank g ≤ c) =>
      le_trans (rank_add_le (f i) g) (add_le_add_left h (rank (f i)))

theorem rank_comp_le1 {K : Type u} {V : Type v} {V' : Type v'} {V'' : Type v''} [field K]
    [add_comm_group V] [vector_space K V] [add_comm_group V'] [vector_space K V']
    [add_comm_group V''] [vector_space K V''] (g : linear_map K V V') (f : linear_map K V' V'') :
    rank (linear_map.comp f g) ≤ rank f :=
  sorry

theorem rank_comp_le2 {K : Type u} {V : Type v} {V' : Type v'} {V'₁ : Type v'} [field K]
    [add_comm_group V] [vector_space K V] [add_comm_group V'] [vector_space K V']
    [add_comm_group V'₁] [vector_space K V'₁] (g : linear_map K V V') (f : linear_map K V' V'₁) :
    rank (linear_map.comp f g) ≤ rank g :=
  sorry

theorem dim_zero_iff_forall_zero {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] : vector_space.dim K V = 0 ↔ ∀ (x : V), x = 0 :=
  sorry

theorem dim_pos_iff_exists_ne_zero {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] : 0 < vector_space.dim K V ↔ ∃ (x : V), x ≠ 0 :=
  sorry

theorem dim_pos_iff_nontrivial {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] : 0 < vector_space.dim K V ↔ nontrivial V :=
  sorry

theorem dim_pos {K : Type u} {V : Type v} [field K] [add_comm_group V] [vector_space K V]
    [h : nontrivial V] : 0 < vector_space.dim K V :=
  iff.mpr dim_pos_iff_nontrivial h

/-- A vector space has dimension at most `1` if and only if there is a
single vector of which all vectors are multiples. -/
theorem dim_le_one_iff {K : Type u} {V : Type v} [field K] [add_comm_group V] [vector_space K V] :
    vector_space.dim K V ≤ 1 ↔ ∃ (v₀ : V), ∀ (v : V), ∃ (r : K), r • v₀ = v :=
  sorry

/-- A submodule has dimension at most `1` if and only if there is a
single vector in the submodule such that the submodule is contained in
its span. -/
theorem dim_submodule_le_one_iff {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] (s : submodule K V) :
    vector_space.dim K ↥s ≤ 1 ↔ ∃ (v₀ : V), ∃ (H : v₀ ∈ s), s ≤ submodule.span K (singleton v₀) :=
  sorry

/-- A submodule has dimension at most `1` if and only if there is a
single vector, not necessarily in the submodule, such that the
submodule is contained in its span. -/
theorem dim_submodule_le_one_iff' {K : Type u} {V : Type v} [field K] [add_comm_group V]
    [vector_space K V] (s : submodule K V) :
    vector_space.dim K ↥s ≤ 1 ↔ ∃ (v₀ : V), s ≤ submodule.span K (singleton v₀) :=
  sorry

/-- Version of linear_equiv.dim_eq without universe constraints. -/
theorem linear_equiv.dim_eq_lift {K : Type u} {V : Type v} {E : Type v'} [field K]
    [add_comm_group V] [vector_space K V] [add_comm_group E] [vector_space K E]
    (f : linear_equiv K V E) :
    cardinal.lift (vector_space.dim K V) = cardinal.lift (vector_space.dim K E) :=
  sorry

end Mathlib


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.geometry.manifold.algebra.smooth_functions
import Mathlib.linear_algebra.finite_dimensional
import Mathlib.analysis.normed_space.inner_product
import Mathlib.PostPort

namespace Mathlib

/-!
# Constructing examples of manifolds over ℝ

We introduce the necessary bits to be able to define manifolds modelled over `ℝ^n`, boundaryless
or with boundary or with corners. As a concrete example, we construct explicitly the manifold with
boundary structure on the real interval `[x, y]`.

More specifically, we introduce
* `model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_half_space n)` for the model space used
  to define `n`-dimensional real manifolds with boundary
* `model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_quadrant n)` for the model space used
  to define `n`-dimensional real manifolds with corners

## Notations

In the locale `manifold`, we introduce the notations
* `𝓡 n` for the identity model with corners on `euclidean_space ℝ (fin n)`
* `𝓡∂ n` for `model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_half_space n)`.

For instance, if a manifold `M` is boundaryless, smooth and modelled on `euclidean_space ℝ (fin m)`,
and `N` is smooth with boundary modelled on `euclidean_half_space n`, and `f : M → N` is a smooth
map, then the derivative of `f` can be written simply as `mfderiv (𝓡 m) (𝓡∂ n) f` (as to why the
model with corners can not be implicit, see the discussion in `smooth_manifold_with_corners.lean`).

## Implementation notes

The manifold structure on the interval `[x, y] = Icc x y` requires the assumption `x < y` as a
typeclass. We provide it as `[fact (x < y)]`.
-/

/--
The half-space in `ℝ^n`, used to model manifolds with boundary. We only define it when
`1 ≤ n`, as the definition only makes sense in this case.
-/
def euclidean_half_space (n : ℕ) [HasZero (fin n)] :=
  Subtype fun (x : euclidean_space ℝ (fin n)) => 0 ≤ x 0

/--
The quadrant in `ℝ^n`, used to model manifolds with corners, made of all vectors with nonnegative
coordinates.
-/
def euclidean_quadrant (n : ℕ) :=
  Subtype fun (x : euclidean_space ℝ (fin n)) => ∀ (i : fin n), 0 ≤ x i

/- Register class instances for euclidean half-space and quadrant, that can not be noticed
without the following reducibility attribute (which is only set in this section). -/

protected instance euclidean_half_space.topological_space {n : ℕ} [HasZero (fin n)] : topological_space (euclidean_half_space n) :=
  subtype.topological_space

protected instance euclidean_quadrant.topological_space {n : ℕ} : topological_space (euclidean_quadrant n) :=
  subtype.topological_space

protected instance euclidean_half_space.inhabited {n : ℕ} [HasZero (fin n)] : Inhabited (euclidean_half_space n) :=
  { default := { val := 0, property := sorry } }

protected instance euclidean_quadrant.inhabited {n : ℕ} : Inhabited (euclidean_quadrant n) :=
  { default := { val := 0, property := sorry } }

theorem range_half_space (n : ℕ) [HasZero (fin n)] : (set.range fun (x : euclidean_half_space n) => subtype.val x) = set_of fun (x : euclidean_space ℝ (fin n)) => 0 ≤ x 0 := sorry

theorem range_quadrant (n : ℕ) : (set.range fun (x : euclidean_quadrant n) => subtype.val x) =
  set_of fun (x : euclidean_space ℝ (fin n)) => ∀ (i : fin n), 0 ≤ x i := sorry

/--
Definition of the model with corners `(euclidean_space ℝ (fin n), euclidean_half_space n)`, used as a
model for manifolds with boundary. In the locale `manifold`, use the shortcut `𝓡∂ n`.
-/
def model_with_corners_euclidean_half_space (n : ℕ) [HasZero (fin n)] : model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_half_space n) :=
  model_with_corners.mk
    (local_equiv.mk (fun (x : euclidean_half_space n) => subtype.val x)
      (fun (x : euclidean_space ℝ (fin n)) =>
        { val := fun (i : fin n) => dite (i = 0) (fun (h : i = 0) => max (x i) 0) fun (h : ¬i = 0) => x i,
          property := sorry })
      set.univ (set.range fun (x : euclidean_half_space n) => subtype.val x) sorry sorry sorry sorry)
    sorry sorry

/--
Definition of the model with corners `(euclidean_space ℝ (fin n), euclidean_quadrant n)`, used as a
model for manifolds with corners -/
def model_with_corners_euclidean_quadrant (n : ℕ) : model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_quadrant n) :=
  model_with_corners.mk
    (local_equiv.mk (fun (x : euclidean_quadrant n) => subtype.val x)
      (fun (x : euclidean_space ℝ (fin n)) => { val := fun (i : fin n) => max (x i) 0, property := sorry }) set.univ
      (set.range fun (x : euclidean_quadrant n) => subtype.val x) sorry sorry sorry sorry)
    sorry sorry

/--
The left chart for the topological space `[x, y]`, defined on `[x,y)` and sending `x` to `0` in
`euclidean_half_space 1`.
-/
def Icc_left_chart (x : ℝ) (y : ℝ) [fact (x < y)] : local_homeomorph (↥(set.Icc x y)) (euclidean_half_space 1) :=
  local_homeomorph.mk
    (local_equiv.mk (fun (z : ↥(set.Icc x y)) => { val := fun (i : fin 1) => subtype.val z - x, property := sorry })
      (fun (z : euclidean_half_space 1) => { val := min (subtype.val z 0 + x) y, property := sorry })
      (set_of fun (z : ↥(set.Icc x y)) => subtype.val z < y)
      (set_of fun (z : euclidean_half_space 1) => subtype.val z 0 < y - x) sorry sorry sorry sorry)
    sorry sorry sorry sorry

/--
The right chart for the topological space `[x, y]`, defined on `(x,y]` and sending `y` to `0` in
`euclidean_half_space 1`.
-/
def Icc_right_chart (x : ℝ) (y : ℝ) [fact (x < y)] : local_homeomorph (↥(set.Icc x y)) (euclidean_half_space 1) :=
  local_homeomorph.mk
    (local_equiv.mk (fun (z : ↥(set.Icc x y)) => { val := fun (i : fin 1) => y - subtype.val z, property := sorry })
      (fun (z : euclidean_half_space 1) => { val := max (y - subtype.val z 0) x, property := sorry })
      (set_of fun (z : ↥(set.Icc x y)) => x < subtype.val z)
      (set_of fun (z : euclidean_half_space 1) => subtype.val z 0 < y - x) sorry sorry sorry sorry)
    sorry sorry sorry sorry

/--
Charted space structure on `[x, y]`, using only two charts taking values in `euclidean_half_space 1`.
-/
protected instance Icc_manifold (x : ℝ) (y : ℝ) [fact (x < y)] : charted_space (euclidean_half_space 1) ↥(set.Icc x y) :=
  charted_space.mk (insert (Icc_left_chart x y) (singleton (Icc_right_chart x y)))
    (fun (z : ↥(set.Icc x y)) => ite (subtype.val z < y) (Icc_left_chart x y) (Icc_right_chart x y)) sorry sorry

/--
The manifold structure on `[x, y]` is smooth.
-/
protected instance Icc_smooth_manifold (x : ℝ) (y : ℝ) [fact (x < y)] : smooth_manifold_with_corners (model_with_corners_euclidean_half_space 1) ↥(set.Icc x y) := sorry

/-! Register the manifold structure on `Icc 0 1`, and also its zero and one. -/

theorem fact_zero_lt_one : fact (0 < 1) :=
  zero_lt_one

protected instance set.Icc.charted_space : charted_space (euclidean_half_space 1) ↥(set.Icc 0 1) :=
  Mathlib.Icc_manifold 0 1

protected instance set.Icc.smooth_manifold_with_corners : smooth_manifold_with_corners (model_with_corners_euclidean_half_space 1) ↥(set.Icc 0 1) :=
  Mathlib.Icc_smooth_manifold 0 1


import Playlean4.Basic
import Playlean4.Group.Basic
import Playlean4.Group.Subgroup
import Playlean4.Group.Action

set_option quotPrecheck.allowSectionVars true

namespace Group.Action.Remarkable

namespace OnSet

variable {G : Type} (law : G → G → G) [grp : Group G law]

local infixl:70 " * " => id' law
@[appUnexpander id'] def unexpandGMul : Lean.PrettyPrinter.Unexpander
  | `(id' Magma.law G $x $y) => `($x * $y)
  | _ => throw ()
local notation "one" => grp.one' -- HACK
local notation g"⁻¹" => grp.inv g

def leftTranslationOnSet : G → Set G → Set G := (liftToSet (onSelf law))
def rightTranslationOnSet : G → Set G → Set G := (@liftToSet G _ (onSelf (lawᵒᵖ)))
def conjugationOnSet : G → Set G → Set G := (liftToSet (conjugation law))

local infix:70 " •ₗ " => leftTranslationOnSet law
local notation:70 lhs:70 " •ᵣ " rhs:70 => rightTranslationOnSet law rhs lhs
local infix:70 " ••  " => conjugationOnSet law

instance leftActionOnSet : Action G law (leftTranslationOnSet law) := actionOnSet _ _

theorem rightTranslationIdentity (P : Set G) : P •ᵣ one = P :=
((@actionOnSet G (lawᵒᵖ) _ _ (onSelf (lawᵒᵖ)) _).identity P)

theorem rightTranslationCompat (g g' : G) (P : Set G) : (P •ᵣ (g * g')) = (P •ᵣ g) •ᵣ g' :=
(@actionOnSet G (lawᵒᵖ) _ _ (onSelf (lawᵒᵖ)) _).compat g' g P

theorem translationCompat (g g' : G) (P : Set G) : (g •ₗ P) •ᵣ g' = g •ₗ (P •ᵣ g') :=
by
  simp only [leftTranslationOnSet, rightTranslationOnSet, liftToSet, Set.imgComp]
  apply Set.imgCongrFun
  funext x
  suffices g * x * g' = g * (x * g') by exact this
  simp

theorem conjugationCompat (g : G) (P : Set G) : g •• P = (g •ₗ P) •ᵣ g⁻¹ :=
by
  simp only [leftTranslationOnSet, rightTranslationOnSet, conjugationOnSet, liftToSet, Set.imgComp]
  apply Set.imgCongrFun
  rfl

def mulOnSet : Set G → Set G → Set G := λ P Q =>
  λ h => ∃ g, g ∈ P ∧ ∃ g', g' ∈ Q ∧ h = g * g'

local infixl:70 " ** " => mulOnSet law

def mulOnSetCompat₁ (P Q : Set G) (g : G) : P ** (g •ₗ Q) = (P •ᵣ g) ** Q :=
by
  funext x
  apply propext
  have p₁ : (P ** (g •ₗ Q)) x ↔ ∃ p, p ∈ P ∧ ∃ q, q ∈ Q ∧ x = p * (g * q)
  by
    apply Iff.intro
    exact λ h => match h with
      | ⟨ p, pIn, res, ⟨ q, qIn, resEq ⟩, xEq ⟩ =>
        ⟨ p, pIn, q, qIn, xEq ▸ resEq ▸ rfl ⟩
    exact λ h => match h with
      | ⟨ p, pIn, q, qIn, h ⟩ =>
        ⟨ p, pIn, g * q, ⟨ q, qIn, rfl ⟩, h ⟩
  have p₂ : (∃ p, p ∈ P ∧ ∃ q, q ∈ Q ∧ x = p * g * q) ↔ ((P •ᵣ g) ** Q) x
  by
    apply Iff.intro
    exact λ h => match h with
      | ⟨ p, pIn, q, qIn, h ⟩ =>
        ⟨ p * g, ⟨ p, pIn, rfl ⟩, q, qIn, h ⟩
    exact λ h => match h with
      | ⟨ res, ⟨ p, pIn, resEq ⟩, q, qIn, xEq ⟩ =>
        ⟨ p, pIn, q, qIn, xEq ▸ resEq ▸ rfl ⟩
  have p₃ : (∃ p, p ∈ P ∧ ∃ q, q ∈ Q ∧ x = p * (g * q)) ↔
    ∃ p, p ∈ P ∧ ∃ q, q ∈ Q ∧ x = p * g * q
  by simp
  exact p₁.trans <| p₃.trans p₂

end OnSet

end Group.Action.Remarkable


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import algebraic_geometry.presheafed_space.has_colimits
import category_theory.limits.shapes.binary_products
import category_theory.limits.preserves.shapes.pullbacks
import topology.sheaves.functors
import algebraic_geometry.Scheme

/-!
# Open immersions of structured spaces

We say that a morphism of presheafed spaces `f : X ⟶ Y` is an open immersions if
the underlying map of spaces is an open embedding `f : X ⟶ U ⊆ Y`,
and the sheaf map `Y(V) ⟶ f _* X(V)` is an iso for each `V ⊆ U`.

Abbreviations are also provided for `SheafedSpace`, `LocallyRingedSpace` and `Scheme`.

## Main definitions

* `algebraic_geometry.PresheafedSpace.is_open_immersion`: the `Prop`-valued typeclass asserting
  that a PresheafedSpace hom `f` is an open_immersion.
* `algebraic_geometry.is_open_immersion`: the `Prop`-valued typeclass asserting
  that a Scheme morphism `f` is an open_immersion.
* `algebraic_geometry.PresheafedSpace.is_open_immersion.iso_restrict`: The source of an
  open immersion is isomorphic to the restriction of the target onto the image.

## Main results

* `algebraic_geometry.PresheafedSpace.is_open_immersion.comp`: The composition of two open
  immersions is an open immersion.
* `algebraic_geometry.PresheafedSpace.is_open_immersion.of_iso`: An iso is an open immersion.
* `algebraic_geometry.PresheafedSpace.is_open_immersion.to_iso`:
  A surjective open immersion is an isomorphism.
* `algebraic_geometry.PresheafedSpace.is_open_immersion.stalk_iso`: An open immersion induces
  an isomorphism on stalks.

-/

open topological_space category_theory opposite
open category_theory.limits
namespace algebraic_geometry

universes v u

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

/--
An open immersion of PresheafedSpaces is an open embedding `f : X ⟶ U ⊆ Y` of the underlying
spaces, such that the sheaf map `Y(V) ⟶ f _* X(V)` is an iso for each `V ⊆ U`.
-/
class PresheafedSpace.is_open_immersion {X Y : PresheafedSpace C} (f : X ⟶ Y) : Prop :=
(base_open : open_embedding f.base)
(c_iso : ∀ U : opens X, is_iso (f.c.app (op (base_open.is_open_map.functor.obj U))))

/--
A morphism of SheafedSpaces is an open immersion if it is an open immersion as a morphism
of PresheafedSpaces
-/
abbreviation SheafedSpace.is_open_immersion
  [has_products C] {X Y : SheafedSpace C} (f : X ⟶ Y) : Prop :=
PresheafedSpace.is_open_immersion f

/--
A morphism of LocallyRingedSpaces is an open immersion if it is an open immersion as a morphism
of SheafedSpaces
-/
abbreviation LocallyRingedSpace.is_open_immersion {X Y : LocallyRingedSpace} (f : X ⟶ Y) : Prop :=
SheafedSpace.is_open_immersion f.1

/--
A morphism of Schemes is an open immersion if it is an open immersion as a morphism
of LocallyRingedSpaces
-/
abbreviation is_open_immersion {X Y : Scheme} (f : X ⟶ Y) : Prop :=
LocallyRingedSpace.is_open_immersion f

namespace PresheafedSpace.is_open_immersion

open PresheafedSpace

local notation `is_open_immersion` := PresheafedSpace.is_open_immersion

attribute [instance] is_open_immersion.c_iso

section

variables {X Y : PresheafedSpace C} {f : X ⟶ Y} (H : is_open_immersion f)

/-- The functor `opens X ⥤ opens Y` associated with an open immersion `f : X ⟶ Y`. -/
abbreviation open_functor := H.base_open.is_open_map.functor

/-
We want to keep `eq_to_hom`s in the form of `F.map (eq_to_hom _)` so that the lemmas about
naturality can be applied.
-/
local attribute [-simp] eq_to_hom_map eq_to_iso_map

/-- An open immersion `f : X ⟶ Y` induces an isomorphism `X ≅ Y|_{f(X)}`. -/
@[simps] noncomputable
def iso_restrict : X ≅ Y.restrict H.base_open :=
PresheafedSpace.iso_of_components (iso.refl _)
begin
  symmetry,
  fapply nat_iso.of_components,
  intro U,
  refine as_iso (f.c.app (op (H.open_functor.obj (unop U)))) ≪≫ X.presheaf.map_iso (eq_to_iso _),
  { induction U using opposite.rec,
    cases U,
    dsimp only [is_open_map.functor, functor.op, opens.map],
    congr' 2,
    erw set.preimage_image_eq _ H.base_open.inj,
    refl },
  { intros U V i,
    simp only [category_theory.eq_to_iso.hom, Top.presheaf.pushforward_obj_map, category.assoc,
      functor.op_map, iso.trans_hom, as_iso_hom, functor.map_iso_hom, ←X.presheaf.map_comp],
    erw [f.c.naturality_assoc, ←X.presheaf.map_comp],
    congr }
end

@[simp] lemma iso_restrict_hom_of_restrict : H.iso_restrict.hom ≫ Y.of_restrict _ = f :=
begin
  ext,
  { simp only [comp_c_app, iso_restrict_hom_c_app, nat_trans.comp_app,
      eq_to_hom_refl, of_restrict_c_app, category.assoc, whisker_right_id'],
    erw [category.comp_id, f.c.naturality_assoc, ←X.presheaf.map_comp],
    transitivity f.c.app x ≫ X.presheaf.map (𝟙 _),
    { congr },
    { erw [X.presheaf.map_id, category.comp_id] } },
  { simp }
end

@[simp] lemma iso_restrict_inv_of_restrict : H.iso_restrict.inv ≫ f = Y.of_restrict _ :=
by { rw iso.inv_comp_eq, simp }

instance mono [H : is_open_immersion f] : mono f :=
by { rw ← H.iso_restrict_hom_of_restrict, apply mono_comp }

/-- The composition of two open immersions is an open immersion. -/
instance comp {Z : PresheafedSpace C} (f : X ⟶ Y) [hf : is_open_immersion f] (g : Y ⟶ Z)
  [hg : is_open_immersion g] :
  is_open_immersion (f ≫ g) :=
{ base_open := hg.base_open.comp hf.base_open,
  c_iso := λ U,
  begin
    generalize_proofs h,
    dsimp only [algebraic_geometry.PresheafedSpace.comp_c_app, unop_op, functor.op, comp_base,
      Top.presheaf.pushforward_obj_obj, opens.map_comp_obj],
    apply_with is_iso.comp_is_iso { instances := ff },
    swap,
    { have : (opens.map g.base).obj (h.functor.obj U) = hf.open_functor.obj U,
      { dsimp only [opens.map, is_open_map.functor, PresheafedSpace.comp_base],
        congr' 1,
        rw [coe_comp, ←set.image_image, set.preimage_image_eq _ hg.base_open.inj] },
      rw this,
      apply_instance },
    { have : h.functor.obj U = hg.open_functor.obj (hf.open_functor.obj U),
      { dsimp only [is_open_map.functor],
        congr' 1,
        rw [comp_base, coe_comp, ←set.image_image],
        congr },
      rw this,
      apply_instance }
  end }

/-- For an open immersion `f : X ⟶ Y` and an open set `U ⊆ X`, we have the map `X(U) ⟶ Y(U)`. -/
noncomputable
def inv_app (U : opens X) : X.presheaf.obj (op U) ⟶ Y.presheaf.obj (op (H.open_functor.obj U)) :=
X.presheaf.map (eq_to_hom (by simp [opens.map, set.preimage_image_eq _ H.base_open.inj])) ≫
  inv (f.c.app (op (H.open_functor.obj U)))

@[simp, reassoc] lemma inv_naturality {U V : (opens X)ᵒᵖ} (i : U ⟶ V) :
  X.presheaf.map i ≫ H.inv_app (unop V) = H.inv_app (unop U) ≫
    Y.presheaf.map (H.open_functor.op.map i) :=
begin
  simp only [inv_app, ←category.assoc],
  rw [is_iso.comp_inv_eq],
  simp only [category.assoc, f.c.naturality, is_iso.inv_hom_id_assoc, ← X.presheaf.map_comp],
  erw ← X.presheaf.map_comp,
  congr
end

instance (U : opens X) : is_iso (H.inv_app U) := by { delta inv_app, apply_instance }

lemma inv_inv_app (U : opens X) :
  inv (H.inv_app U) = f.c.app (op (H.open_functor.obj U)) ≫
    X.presheaf.map (eq_to_hom (by simp [opens.map, set.preimage_image_eq _ H.base_open.inj])) :=
begin
  rw ← cancel_epi (H.inv_app U),
  rw is_iso.hom_inv_id,
  delta inv_app,
  simp [← functor.map_comp]
end

@[simp, reassoc] lemma inv_app_app (U : opens X) :
  H.inv_app U ≫ f.c.app (op (H.open_functor.obj U)) =
    X.presheaf.map (eq_to_hom (by simp [opens.map, set.preimage_image_eq _ H.base_open.inj])) :=
by rw [inv_app, category.assoc, is_iso.inv_hom_id, category.comp_id]

@[simp, reassoc] lemma app_inv_app (U : opens Y) :
  f.c.app (op U) ≫ H.inv_app ((opens.map f.base).obj U) =
  Y.presheaf.map ((hom_of_le (by exact set.image_preimage_subset f.base U)).op :
    op U ⟶ op (H.open_functor.obj ((opens.map f.base).obj U))) :=
by { erw ← category.assoc, rw [is_iso.comp_inv_eq, f.c.naturality], congr }

/-- A variant of `app_inv_app` that gives an `eq_to_hom` instead of `hom_of_le`. -/
@[reassoc] lemma app_inv_app' (U : opens Y) (hU : (U : set Y) ⊆ set.range f.base) :
  f.c.app (op U) ≫ H.inv_app ((opens.map f.base).obj U) =
  Y.presheaf.map (eq_to_hom (by
    { apply has_le.le.antisymm,
      { exact set.image_preimage_subset f.base U.1 },
      { change U ⊆ _,
        refine has_le.le.trans_eq _ (@set.image_preimage_eq_inter_range _ _ f.base U.1).symm,
        exact set.subset_inter_iff.mpr ⟨λ _ h, h, hU⟩ } })).op :=
by { erw ← category.assoc, rw [is_iso.comp_inv_eq, f.c.naturality], congr }

/-- An isomorphism is an open immersion. -/
instance of_iso {X Y : PresheafedSpace C} (H : X ≅ Y) : is_open_immersion H.hom :=
{ base_open := (Top.homeo_of_iso ((forget C).map_iso H)).open_embedding,
  c_iso := λ _, infer_instance }

@[priority 100]
instance of_is_iso {X Y : PresheafedSpace C} (f : X ⟶ Y) [is_iso f] : is_open_immersion f :=
algebraic_geometry.PresheafedSpace.is_open_immersion.of_iso (as_iso f)

instance of_restrict {X : Top} (Y : PresheafedSpace C) {f : X ⟶ Y.carrier}
  (hf : open_embedding f) : is_open_immersion (Y.of_restrict hf) :=
{ base_open := hf,
  c_iso := λ U,
  begin
    dsimp,
    have : (opens.map f).obj (hf.is_open_map.functor.obj U) = U,
    { cases U,
      dsimp only [opens.map, is_open_map.functor],
      congr' 1,
      rw set.preimage_image_eq _ hf.inj,
      refl },
    convert (show is_iso (Y.presheaf.map (𝟙 _)), from infer_instance),
    { apply subsingleton.helim,
      rw this },
    { rw Y.presheaf.map_id,
      apply_instance }
  end }

/-- An open immersion is an iso if the underlying continuous map is epi. -/
lemma to_iso (f : X ⟶ Y) [h : is_open_immersion f] [h' : epi f.base] : is_iso f :=
begin
  apply_with is_iso_of_components { instances := ff },
  { let : X ≃ₜ Y := (homeomorph.of_embedding _ h.base_open.to_embedding).trans
    { to_fun := subtype.val, inv_fun := λ x, ⟨x,
      by { rw set.range_iff_surjective.mpr ((Top.epi_iff_surjective _).mp h'), trivial }⟩,
      left_inv := λ ⟨_,_⟩, rfl, right_inv := λ _, rfl },
    convert is_iso.of_iso (Top.iso_of_homeo this),
    { ext, refl } },
  { apply_with nat_iso.is_iso_of_is_iso_app { instances := ff },
    intro U,
    have : U = op (h.open_functor.obj ((opens.map f.base).obj (unop U))),
    { induction U using opposite.rec,
      cases U,
      dsimp only [functor.op, opens.map],
      congr,
      exact (set.image_preimage_eq _ ((Top.epi_iff_surjective _).mp h')).symm },
    convert @@is_open_immersion.c_iso _ h ((opens.map f.base).obj (unop U)) }
end

instance stalk_iso [has_colimits C] [H : is_open_immersion f] (x : X) : is_iso (stalk_map f x) :=
begin
  rw ← H.iso_restrict_hom_of_restrict,
  rw PresheafedSpace.stalk_map.comp,
  apply_instance
end

end

end PresheafedSpace.is_open_immersion

end algebraic_geometry


import tactic.generalize_proofs

example (x : ℕ) (h : x < 2) : classical.some ⟨x, h⟩ < 2 :=
begin
  generalize_proofs a,
  guard_hyp a : ∃ x, x < 2,
  guard_target classical.some a < 2,
  exact classical.some_spec a,
end

example (a : ∃ x, x < 2) : classical.some a < 2 :=
begin
  generalize_proofs,
  guard_target classical.some a < 2,
  exact classical.some_spec a,
end

example (x : ℕ) (h : x < 2) (a : ∃ x, x < 2) : classical.some a < 2 :=
begin
  generalize_proofs,
  guard_target classical.some a < 2,
  exact classical.some_spec a,
end

example (x : ℕ) (h : x < 2) (H : classical.some ⟨x, h⟩ < 2) : classical.some ⟨x, h⟩ < 2 :=
begin
  generalize_proofs a at H ⊢,
  guard_hyp a : ∃ x, x < 2,
  guard_hyp H : classical.some a < 2,
  guard_target classical.some a < 2,
  exact H,
end

local attribute [instance] classical.prop_decidable

example (H : ∀ x, x = 1) : (if h : ∃ (k : ℕ), k = 1 then classical.some h else 0) = 1 :=
begin
  rw [dif_pos], tactic.swap, { exact ⟨1, rfl⟩ },
  generalize_proofs h,
  guard_target classical.some h = 1,
  apply H
end


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

import tactic.interactive
import tactic.finish
import tactic.ext
import tactic.lift
import tactic.apply
import tactic.reassoc_axiom
import tactic.tfae
import tactic.elide
import tactic.ring_exp
import tactic.clear
import tactic.simp_rw

example (m n p q : nat) (h : m + n = p) : true :=
begin
  have : m + n = q,
  { generalize_hyp h' : m + n = x at h,
    guard_hyp h' : m + n = x,
    guard_hyp h : x = p,
    guard_target m + n = q,
    admit },
  have : m + n = q,
  { generalize_hyp h' : m + n = x at h ⊢,
    guard_hyp h' : m + n = x,
    guard_hyp h : x = p,
    guard_target x = q,
    admit },
  trivial
end

example (α : Sort*) (L₁ L₂ L₃ : list α)
  (H : L₁ ++ L₂ = L₃) : true :=
begin
  have : L₁ ++ L₂ = L₂,
  { generalize_hyp h : L₁ ++ L₂ = L at H,
    induction L with hd tl ih,
    case list.nil
    { tactic.cleanup,
      change list.nil = L₃ at H,
      admit },
    case list.cons
    { change list.cons hd tl = L₃ at H,
      admit } },
  trivial
end

example (x y : ℕ) (p q : Prop) (h : x = y) (h' : p ↔ q) : true :=
begin
  symmetry' at h,
  guard_hyp' h : y = x,
  guard_hyp' h' : p ↔ q,
  symmetry' at *,
  guard_hyp' h : x = y,
  guard_hyp' h' : q ↔ p,
  trivial
end

section h_generalize

variables {α β γ φ ψ : Type} (f : α → α → α → φ → γ)
          (x y : α) (a b : β) (z : φ)
          (h₀ : β = α) (h₁ : β = α) (h₂ : φ = β)
          (hx : x == a) (hy : y == b) (hz : z == a)
include f x y z a b hx hy hz

example : f x y x z = f (eq.rec_on h₀ a) (cast h₀ b) (eq.mpr h₁.symm a) (eq.mpr h₂ a) :=
begin
  guard_hyp_nums 16,
  h_generalize hp : a == p with hh,
  guard_hyp_nums 19,
  guard_hyp' hh : β = α,
  guard_target f x y x z = f p (cast h₀ b) p (eq.mpr h₂ a),
  h_generalize hq : _ == q,
  guard_hyp_nums 21,
  guard_target f x y x z = f p q p (eq.mpr h₂ a),
  h_generalize _ : _ == r,
  guard_hyp_nums 23,
  guard_target f x y x z = f p q p r,
  casesm* [_ == _, _ = _], refl
end

end h_generalize

section h_generalize

variables {α β γ φ ψ : Type} (f : list α → list α → γ)
          (x : list α) (a : list β) (z : φ)
          (h₀ : β = α) (h₁ : list β = list α)
          (hx : x == a)
include f x z a hx h₀ h₁

example : true :=
begin
  have : f x x = f (eq.rec_on h₀ a) (cast h₁ a),
  { guard_hyp_nums 11,
    h_generalize : a == p with _,
    guard_hyp_nums 13,
    guard_hyp' h : β = α,
    guard_target f x x = f p (cast h₁ a),
    h_generalize! : a == q ,
    guard_hyp_nums 13,
    guard_target ∀ q, f x x = f p q,
    casesm* [_ == _, _ = _],
    success_if_fail { refl },
    admit },
  trivial
end

end h_generalize

section tfae

example (p q r s : Prop)
  (h₀ : p ↔ q)
  (h₁ : q ↔ r)
  (h₂ : r ↔ s) :
  p ↔ s :=
begin
  scc,
end

example (p' p q r r' s s' : Prop)
  (h₀ : p' → p)
  (h₀ : p → q)
  (h₁ : q → r)
  (h₁ : r' → r)
  (h₂ : r ↔ s)
  (h₂ : s → p)
  (h₂ : s → s') :
  p ↔ s :=
begin
  scc,
end

example (p' p q r r' s s' : Prop)
  (h₀ : p' → p)
  (h₀ : p → q)
  (h₁ : q → r)
  (h₁ : r' → r)
  (h₂ : r ↔ s)
  (h₂ : s → p)
  (h₂ : s → s') :
  p ↔ s :=
begin
  scc',
  assumption
end

example : tfae [true, ∀ n : ℕ, 0 ≤ n * n, true, true] := begin
  tfae_have : 3 → 1, { intro h, constructor },
  tfae_have : 2 → 3, { intro h, constructor },
  tfae_have : 2 ← 1, { intros h n, apply nat.zero_le },
  tfae_have : 4 ↔ 2, { tauto },
  tfae_finish,
end

example : tfae [] := begin
  tfae_finish,
end

variables P Q R : Prop

example (pq : P → Q) (qr : Q → R) (rp : R → P) : tfae [P, Q, R] :=
begin
  tfae_finish
end

example (pq : P ↔ Q) (qr : Q ↔ R) : tfae [P, Q, R] :=
begin
  tfae_finish -- the success or failure of this tactic is nondeterministic!
end

example (p : unit → Prop) : tfae [p (), p ()] :=
begin
  tfae_have : 1 ↔ 2, from iff.rfl,
  tfae_finish
end

end tfae

section clear_aux_decl

example (n m : ℕ) (h₁ : n = m) (h₂ : ∃ a : ℕ, a = n ∧ a = m) : 2 * m = 2 * n :=
let ⟨a, ha⟩ := h₂ in
begin
  clear_aux_decl, -- subst will fail without this line
  subst h₁
end

example (x y : ℕ) (h₁ : ∃ n : ℕ, n * 1 = 2) (h₂ : 1 + 1 = 2 → x * 1 = y) : x = y :=
let ⟨n, hn⟩ := h₁ in
begin
  clear_aux_decl, -- finish produces an error without this line
  finish
end

end clear_aux_decl

section swap

example {α₁ α₂ α₃ : Type} : true :=
by {have : α₁, have : α₂, have : α₃, swap, swap,
    rotate, rotate, rotate, rotate 2, rotate 2, triv, recover}

end swap

private meta def get_exception_message (t : lean.parser unit) : lean.parser string
| s := match t s with
       | result.success a s' := result.success "No exception" s
       | result.exception none pos s' := result.success "Exception no msg" s
       | result.exception (some msg) pos s' := result.success (msg ()).to_string s
       end

@[user_command] meta def test_parser1_fail_cmd
(_ : interactive.parse (lean.parser.tk "test_parser1")) : lean.parser unit :=
do
  let msg := "oh, no!",
  let t : lean.parser unit := tactic.fail msg,
  s ← get_exception_message t,
  if s = msg then tactic.skip
  else interaction_monad.fail "Message was corrupted while being passed through `lean.parser.of_tactic`"
.

-- Due to `lean.parser.of_tactic'` priority, the following *should not* fail with
-- a VM check error, and instead catch the error gracefully and just
-- run and succeed silently.
test_parser1

section category_theory
open category_theory
variables {C : Type} [category.{1} C]

example (X Y Z W : C) (x : X ⟶ Y) (y : Y ⟶ Z) (z z' : Z ⟶ W) (w : X ⟶ Z)
  (h : x ≫ y = w)
  (h' : y ≫ z = y ≫ z') :
  x ≫ y ≫ z = w ≫ z' :=
begin
  rw [h',reassoc_of h],
end

end category_theory

section is_eta_expansion
/- test the is_eta_expansion tactic -/
open function tactic
structure my_equiv (α : Sort*) (β : Sort*) :=
(to_fun    : α → β)
(inv_fun   : β → α)
(left_inv  : left_inverse inv_fun to_fun)
(right_inv : right_inverse inv_fun to_fun)

infix ` my≃ `:25 := my_equiv

protected def my_rfl {α} : α my≃ α :=
⟨id, λ x, x, λ x, rfl, λ x, rfl⟩

def eta_expansion_test : ℕ × ℕ := ((1,0).1,(1,0).2)
run_cmd do e ← get_env, x ← e.get `eta_expansion_test,
  let v := (x.value.get_app_args).drop 2,
  let nms := [`prod.fst, `prod.snd],
  guard $ expr.is_eta_expansion_test (nms.zip v) = some `((1, 0))

def eta_expansion_test2 : ℕ my≃ ℕ :=
⟨my_rfl.to_fun, my_rfl.inv_fun, λ x, rfl, λ x, rfl⟩

run_cmd do e ← get_env, x ← e.get `eta_expansion_test2,
  let v := (x.value.get_app_args).drop 2,
  projs ← e.structure_fields_full `my_equiv,
  b ← expr.is_eta_expansion_aux x.value (projs.zip v),
  guard $ b = some `(@my_rfl ℕ)

run_cmd do e ← get_env, x1 ← e.get `eta_expansion_test, x2 ← e.get `eta_expansion_test2,
  b1 ← expr.is_eta_expansion x1.value,
  b2 ← expr.is_eta_expansion x2.value,
  guard $ b1 = some `((1, 0)) ∧ b2 = some `(@my_rfl ℕ)

structure my_str (n : ℕ) := (x y : ℕ)

def dummy : my_str 3 := ⟨1, 1⟩
def wrong_param : my_str 2 := ⟨dummy.1, dummy.2⟩
def right_param : my_str 3 := ⟨dummy.1, dummy.2⟩

run_cmd do e ← get_env,
  x ← e.get `wrong_param, o ← x.value.is_eta_expansion,
  guard o.is_none,
  x ← e.get `right_param, o ← x.value.is_eta_expansion,
  guard $ o = some `(dummy)

end is_eta_expansion

section elide

variables {x y z w : ℕ}
variables (h  : x + y + z ≤ w)
          (h' : x ≤ y + z + w)
include h h'

example : x + y + z ≤ w :=
begin
  elide 0 at h,
  elide 2 at h',
  guard_hyp h : @hidden _ (x + y + z ≤ w),
  guard_hyp h' : x ≤ @has_add.add (@hidden Type nat) (@hidden (has_add nat) nat.has_add)
                                   (@hidden ℕ (y + z)) (@hidden ℕ w),
  unelide at h,
  unelide at h',
  guard_hyp h' : x ≤ y + z + w,
  exact h, -- there was a universe problem in `elide`. `exact h` lets the kernel check
           -- the consistency of the universes
end

end elide

section struct_eq

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

example {α : Type*} : Π (x y : foo α), x.x = y.x → x.y = y.y → x.z == y.z → x.k = y.k → x = y :=
foo.ext

example {α : Type*} : Π (x y : foo α), x = y ↔ x.x = y.x ∧ x.y = y.y ∧ x.z == y.z ∧ x.k = y.k :=
foo.ext_iff

example {α} (x y : foo α) (h : x = y) : y = x :=
begin
  ext,
  { guard_target' y.x = x.x, rw h },
  { guard_target' y.y = x.y, rw h },
  { guard_target' y.z == x.z, rw h },
  { guard_target' y.k = x.k, rw h },
end

end struct_eq

section ring_exp
  example (a b : ℤ) (n : ℕ) : (a + b)^(n + 2) = (a^2 + 2 * a * b + b^2) * (a + b)^n := by ring_exp
end ring_exp

section clear'

example (a : ℕ) (b : fin a) : unit :=
begin
  success_if_fail { clear a b }, -- fails since `b` depends on `a`
  success_if_fail { clear' a },  -- fails since `b` depends on `a`
  clear' a b,
  guard_hyp_nums 0,
  exact ()
end

example (a : ℕ) : fin a → unit :=
begin
  success_if_fail { clear' a },          -- fails since the target depends on `a`
  success_if_fail { clear_dependent a }, -- ditto
  exact λ _, ()
end

example (a : unit) : unit :=
begin
  -- Check we fail with an error (but don't segfault) if hypotheses are repeated.
  success_if_fail { clear' a a },
  success_if_fail { clear_dependent a a },
  exact ()
end

example (a a a : unit) : unit :=
begin
  -- If there are multiple hypotheses with the same name,
  -- `clear'`/`clear_dependent` currently clears only the last.
  clear' a,
  clear_dependent a,
  guard_hyp_nums 1,
  exact ()
end

end clear'

section clear_dependent

example (a : ℕ) (b : fin a) : unit :=
begin
  success_if_fail { clear' a }, -- fails since `b` depends on `a`
  clear_dependent a,
  guard_hyp_nums 0,
  exact ()
end

end clear_dependent

section simp_rw
  example {α β : Type} {f : α → β} {t : set β} :
    (∀ s, f '' s ⊆ t) = ∀ s : set α, ∀ x ∈ s, x ∈ f ⁻¹' t :=
  by simp_rw [set.image_subset_iff, set.subset_def]
end simp_rw

section local_definitions
/- Some tactics about local definitions.
  Testing revert_deps, revert_after, generalize', clear_value. -/
open tactic
example {A : ℕ → Type} {n : ℕ} : let k := n + 3, l := k + n, f : A k → A k := id in
  ∀(x : A k) (y : A (n + k)) (z : A n) (h : k = n + n), unit :=
begin
  intros, guard_target unit,
  do { e ← get_local `k, e1 ← tactic.local_def_value e, e2 ← to_expr ```(n + 3), guard $ e1 = e2 },
  do { e ← get_local `n, success_if_fail_with_msg (tactic.local_def_value e)
    "Variable n is not a local definition." },
  do { success_if_fail_with_msg (tactic.local_def_value `(1 + 2))
    "No such hypothesis 1 + 2." },
  revert_deps k, tactic.intron 5, guard_target unit,
  revert_after n, tactic.intron 7, guard_target unit,
  do {
    e ← get_local `k,
    tactic.revert_reverse_dependencies_of_hyp e,
    l ← local_context,
    guard $ e ∈ l,
    intros },
  exact unit.star
end

example {A : ℕ → Type} {n : ℕ} : let k := n + 3, l := k + n, f : A k → A (n+3) := id in
  ∀(x : A k) (y : A (n + k)) (z : A n) (h : k = n + n), unit :=
begin
  intros,
  success_if_fail_with_msg {generalize : n + k = x}
    "generalize tactic failed, failed to find expression in the target",
  generalize' : n + k = x,
  generalize' h : n + k = y,
  exact unit.star
end

example {A : ℕ → Type} {n : ℕ} : let k := n + 3, l := k + n, f : A k → A (n+3) := id in
  ∀(x : A k) (y : A (n + k)) (z : A n) (h : k = n + n), unit :=
begin
  intros,
  tactic.to_expr ```(n + n) >>= λ e, tactic.generalize' e `xxx,
  success_if_fail_with_msg {clear_value n}
    "Cannot clear the body of n. It is not a local definition.",
  success_if_fail_with_msg {clear_value k}
    "Cannot clear the body of k. The resulting goal is not type correct.",
  clear_value k f,
  get_local `k, -- test that `k` is not renamed.
  exact unit.star
end

example {A : ℕ → Type} {n : ℕ} : let k := n + 3, l := k + n, f : A k → A k := id in
  ∀(x : A k) (y : A (n + k)) (z : A n) (h : k = n + n), unit :=
begin
  intros,
  clear_value k f,
  exact unit.star
end

/-- test `clear_value` and the preservation of naming -/
example : ∀ x y : ℤ, let z := x + y in x = z - y → x = y - z → true :=
begin
  introv h h,
  guard_hyp x : ℤ,
  guard_hyp y : ℤ,
  guard_hyp z : ℤ := x + y,
  guard_hyp h : x = y - z,
  suffices : true, -- test the type of the second assumption named `h`
  { clear h,
    guard_hyp h : x = z - y,
    assumption },
  do { to_expr ```(z) >>= is_local_def },
  clear_value z,
  guard_hyp z : ℤ,
  success_if_fail { do { to_expr ```(z) >>= is_local_def } },
  guard_hyp h : x = y - z,
  suffices : true,
  { clear h,
    guard_hyp h : x = z - y,
    assumption },
  trivial
end

/- Test whether generalize' always uses the exact name stated by the user, even if that name already
  exists. -/
example (n : Type) (k : ℕ) : k = 5 → unit :=
begin
  generalize' : 5 = n,
  guard_target (k = n → unit),
  intro, constructor
end

/- Test that `generalize'` works correctly with argument `h`, when the expression occurs in the
  target -/
example (n : Type) (k : ℕ) : k = 5 → unit :=
begin
  generalize' h : 5 = n,
  guard_target (k = n → unit),
  intro, constructor
end

end local_definitions

section set_attribute

open tactic

@[user_attribute] meta def my_user_attribute : user_attribute unit bool :=
{ name := `my_attr,
  descr := "",
  parser := return ff }

run_cmd do nm ← get_user_attribute_name `library_note, guard $ nm = `library_note_attr
run_cmd do nm ← get_user_attribute_name `higher_order, guard $ nm = `tactic.higher_order_attr
run_cmd do success_if_fail $ get_user_attribute_name `zxy.xzy

run_cmd set_attribute `norm `prod.map tt
run_cmd set_attribute `my_attr `prod.map
run_cmd set_attribute `to_additive `has_mul
run_cmd success_if_fail $ set_attribute `higher_order `prod.map tt
run_cmd success_if_fail $ set_attribute `norm `xyz.zxy
run_cmd success_if_fail $ set_attribute `zxy.xyz `prod.map

end set_attribute


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Mario Carneiro, Reid Barton
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.category.Top.opens
import Mathlib.PostPort

universes v u

namespace Mathlib

/-!
# Presheaves on a topological space

We define `presheaf C X` simply as `(opens X)ᵒᵖ ⥤ C`,
and inherit the category structure with natural transformations as morphisms.

We define
* `pushforward_obj {X Y : Top.{v}} (f : X ⟶ Y) (ℱ : X.presheaf C) : Y.presheaf C`
with notation `f _* ℱ`
and for `ℱ : X.presheaf C` provide the natural isomorphisms
* `pushforward.id : (𝟙 X) _* ℱ ≅ ℱ``
* `pushforward.comp : (f ≫ g) _* ℱ ≅ g _* (f _* ℱ)`
along with their `@[simp]` lemmas.
-/

namespace Top

def presheaf (C : Type u) [category_theory.category C] (X : Top) := topological_space.opens ↥Xᵒᵖ ⥤ C

namespace presheaf

/-- Pushforward a presheaf on `X` along a continuous map `f : X ⟶ Y`, obtaining a presheaf on `Y`. -/
def pushforward_obj {C : Type u} [category_theory.category C] {X : Top} {Y : Top} (f : X ⟶ Y)
    (ℱ : presheaf C X) : presheaf C Y :=
  category_theory.functor.op (topological_space.opens.map f) ⋙ ℱ

infixl:80 " _* " => Mathlib.Top.presheaf.pushforward_obj

@[simp] theorem pushforward_obj_obj {C : Type u} [category_theory.category C] {X : Top} {Y : Top}
    (f : X ⟶ Y) (ℱ : presheaf C X) (U : topological_space.opens ↥Yᵒᵖ) :
    category_theory.functor.obj (f _* ℱ) U =
        category_theory.functor.obj ℱ
          (category_theory.functor.obj (category_theory.functor.op (topological_space.opens.map f))
            U) :=
  rfl

@[simp] theorem pushforward_obj_map {C : Type u} [category_theory.category C] {X : Top} {Y : Top}
    (f : X ⟶ Y) (ℱ : presheaf C X) {U : topological_space.opens ↥Yᵒᵖ}
    {V : topological_space.opens ↥Yᵒᵖ} (i : U ⟶ V) :
    category_theory.functor.map (f _* ℱ) i =
        category_theory.functor.map ℱ
          (category_theory.functor.map (category_theory.functor.op (topological_space.opens.map f))
            i) :=
  rfl

def pushforward_eq {C : Type u} [category_theory.category C] {X : Top} {Y : Top} {f : X ⟶ Y}
    {g : X ⟶ Y} (h : f = g) (ℱ : presheaf C X) : f _* ℱ ≅ g _* ℱ :=
  category_theory.iso_whisker_right
    (category_theory.nat_iso.op (category_theory.iso.symm (topological_space.opens.map_iso f g h)))
    ℱ

@[simp] theorem pushforward_eq_hom_app {C : Type u} [category_theory.category C] {X : Top} {Y : Top}
    {f : X ⟶ Y} {g : X ⟶ Y} (h : f = g) (ℱ : presheaf C X) (U : topological_space.opens ↥Yᵒᵖ) :
    category_theory.nat_trans.app (category_theory.iso.hom (pushforward_eq h ℱ)) U =
        category_theory.functor.map ℱ
          (id
            (category_theory.has_hom.hom.op
              (category_theory.eq_to_hom
                (eq.mpr
                  (id
                    (Eq._oldrec
                      (Eq.refl
                        (category_theory.functor.obj (topological_space.opens.map g)
                            (opposite.unop U) =
                          category_theory.functor.obj (topological_space.opens.map f)
                            (opposite.unop U)))
                      h))
                  (Eq.refl
                    (category_theory.functor.obj (topological_space.opens.map g)
                      (opposite.unop U))))))) :=
  rfl

@[simp] theorem pushforward_eq_rfl {C : Type u} [category_theory.category C] {X : Top} {Y : Top}
    (f : X ⟶ Y) (ℱ : presheaf C X) (U : topological_space.opens ↥Y) :
    category_theory.nat_trans.app (category_theory.iso.hom (pushforward_eq rfl ℱ)) (opposite.op U) =
        𝟙 :=
  sorry

theorem pushforward_eq_eq {C : Type u} [category_theory.category C] {X : Top} {Y : Top} {f : X ⟶ Y}
    {g : X ⟶ Y} (h₁ : f = g) (h₂ : f = g) (ℱ : presheaf C X) :
    pushforward_eq h₁ ℱ = pushforward_eq h₂ ℱ :=
  rfl

namespace pushforward

def id {C : Type u} [category_theory.category C] {X : Top} (ℱ : presheaf C X) : 𝟙 _* ℱ ≅ ℱ :=
  category_theory.iso_whisker_right
      (category_theory.nat_iso.op (category_theory.iso.symm (topological_space.opens.map_id X)))
      ℱ ≪≫
    category_theory.functor.left_unitor ℱ

@[simp] theorem id_hom_app' {C : Type u} [category_theory.category C] {X : Top} (ℱ : presheaf C X)
    (U : set ↥X) (p : is_open U) :
    category_theory.nat_trans.app (category_theory.iso.hom (id ℱ))
          (opposite.op { val := U, property := p }) =
        category_theory.functor.map ℱ 𝟙 :=
  sorry

@[simp] theorem id_hom_app {C : Type u} [category_theory.category C] {X : Top} (ℱ : presheaf C X)
    (U : topological_space.opens ↥Xᵒᵖ) :
    category_theory.nat_trans.app (category_theory.iso.hom (id ℱ)) U =
        category_theory.functor.map ℱ
          (category_theory.eq_to_hom (topological_space.opens.op_map_id_obj U)) :=
  sorry

@[simp] theorem id_inv_app' {C : Type u} [category_theory.category C] {X : Top} (ℱ : presheaf C X)
    (U : set ↥X) (p : is_open U) :
    category_theory.nat_trans.app (category_theory.iso.inv (id ℱ))
          (opposite.op { val := U, property := p }) =
        category_theory.functor.map ℱ 𝟙 :=
  sorry

def comp {C : Type u} [category_theory.category C] {X : Top} (ℱ : presheaf C X) {Y : Top} {Z : Top}
    (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g) _* ℱ ≅ g _* (f _* ℱ) :=
  category_theory.iso_whisker_right
    (category_theory.nat_iso.op (category_theory.iso.symm (topological_space.opens.map_comp f g))) ℱ

@[simp] theorem comp_hom_app {C : Type u} [category_theory.category C] {X : Top} (ℱ : presheaf C X)
    {Y : Top} {Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) (U : topological_space.opens ↥Zᵒᵖ) :
    category_theory.nat_trans.app (category_theory.iso.hom (comp ℱ f g)) U = 𝟙 :=
  sorry

@[simp] theorem comp_inv_app {C : Type u} [category_theory.category C] {X : Top} (ℱ : presheaf C X)
    {Y : Top} {Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) (U : topological_space.opens ↥Zᵒᵖ) :
    category_theory.nat_trans.app (category_theory.iso.inv (comp ℱ f g)) U = 𝟙 :=
  sorry

end pushforward

/--
A morphism of presheaves gives rise to a morphisms of the pushforwards of those presheaves.
-/
def pushforward_map {C : Type u} [category_theory.category C] {X : Top} {Y : Top} (f : X ⟶ Y)
    {ℱ : presheaf C X} {𝒢 : presheaf C X} (α : ℱ ⟶ 𝒢) : f _* ℱ ⟶ f _* 𝒢 :=
  category_theory.nat_trans.mk
    fun (U : topological_space.opens ↥Yᵒᵖ) =>
      category_theory.nat_trans.app α
        (category_theory.functor.obj (category_theory.functor.op (topological_space.opens.map f)) U)

end Mathlib


--- Will clean up these imports
import tactic
import analysis.calculus.iterated_deriv
import topology.continuous_function.polynomial
import topology.separation
import topology.path_connected
import analysis.complex.basic
import analysis.calculus.tangent_cone
import analysis.normed_space.units
import analysis.asymptotics.asymptotic_equivalent
import analysis.analytic.basic
import geometry.manifold.algebra.smooth_functions
import linear_algebra.finite_dimensional
import analysis.normed_space.inner_product
import topology.metric_space.basic
import topology.continuous_on
import analysis.calculus.formal_multilinear_series

open set complex classical filter asymptotics continuous_linear_map set metric is_open differentiable
open_locale topological_space classical nnreal asymptotics filter ennreal unit_interval

noncomputable theory

--- Some assumptions

theorem holomorph_analytic (f : ℂ → ℂ) (z : ℂ) : differentiable_at ℂ f z ↔ analytic_at ℂ f z :=
sorry

theorem smooth_within_at_iff_holomorph_within_at (f : ℂ → ℂ) {s : set ℂ} (h : is_open s) : ∀ (z : ℂ), (differentiable_within_at ℂ f s z ↔ times_cont_diff_within_at ℂ ⊤ f s z):=
sorry

theorem smooth_at_iff_holomorph_at (f : ℂ → ℂ) : ∀ (z : ℂ), (differentiable_at ℂ f z ↔ times_cont_diff_at ℂ ⊤ f z) :=
sorry

theorem smooth_on_iff_holomorph_on (f : ℂ → ℂ) {s : set ℂ} (h : is_open s) : differentiable_on ℂ f s ↔ times_cont_diff_on ℂ ⊤ f s :=
sorry

section accuml_pts

--- Need this?
--- def isolated_pt (X : Type*) [topological_space X] (U : set X) (z : X) : Prop :=
--- ∃ (V : set X), is_open V ∧ U ∩ (V \ {z}) = ∅

def accumulation_pt (X : Type*) [topological_space X] (U : set X) (z : X) : Prop :=
∀ (V : set X), V ∈ (𝓝 z) → ∃ (v : X), v ∈ U ∩ V ∧ ¬ v = z

lemma accumulation_pt_open_inter {X : Type*} [topological_space X]
  {U : set X} {U' : set X} {z : X}
  (hU' : is_open U') (HU' : z ∈ U') (hz : accumulation_pt X U z) :
  accumulation_pt X (U ∩ U') z :=
λ V hV, (set.inter_assoc U U' V).symm ▸
  (hz (U' ∩ V) $ _root_.mem_nhds_iff.mpr $
    let ⟨t, ht, ht₁, ht₂⟩ := _root_.mem_nhds_iff.mp hV in
    ⟨U' ∩ t, ⟨set.inter_subset_inter_right U' ht, ⟨is_open.inter hU' ht₁, ⟨HU', ht₂⟩⟩⟩⟩)
--
lemma accumulation_pt_mem_closure {X : Type*} [topological_space X]
  {U : set X} {z : X} (hz : accumulation_pt X U z) :
  z ∈ closure U :=
begin
  rw _root_.mem_closure_iff,
  intros o ho hxo,
  rcases hz o (is_open.mem_nhds ho hxo) with ⟨v, hv₁, hv₂⟩,
  use v,
  rw set.inter_comm at hv₁,
  exact hv₁,
end

end accuml_pts

section crowded_space

class crowded_space (X : Type*) [t : topological_space X] :=
(is_crowded : ∀ (x : X), ¬ t.is_open {x})

lemma crowded_space.def (X : Type*) [t : topological_space X] [cr : crowded_space X] :
∀ (x : X), ¬ t.is_open {x} := cr.is_crowded

lemma mem_frontier (X : Type*) [t : topological_space X] {U : set X} {z : X} :
  z ∈ frontier U → ∀ (V : set X), V ∈ 𝓝 z → (V ∩ U ≠ ∅ ∧ V \ U ≠ ∅) :=
begin
  intros hz,
  rw frontier at hz,
  have h : ∀ (o : set X), is_open o → z ∈ o → (o ∩ U).nonempty :=
    _root_.mem_closure_iff.mp (mem_of_mem_diff hz),
  have h' : ¬ (∃ (o : set X) (H : o ⊆ U), is_open o ∧ z ∈ o),
  { let p := not_mem_of_mem_diff hz, rw [mem_interior] at p, exact p, },
  simp at h',
  intros V hV,
  rcases _root_.mem_nhds_iff.mp hV with ⟨V', hV'₁, hV'₂, hV'₃⟩,
  split,
  { exact set.nonempty.ne_empty (set.nonempty.mono (set.inter_subset_inter_left _ hV'₁) $ h V' hV'₂ hV'₃), },
  { by_contra w,
    simp at w,
    rw [diff_eq_empty] at w,
    show false, from (h' V' (set.subset.trans hV'₁ w) hV'₂) hV'₃, },
end

lemma t1_space_connected_with_two_points_is_crowded (X : Type*)
  [t : topological_space X] [c : connected_space X] [h : t1_space X]
  (hX : ∀ (x : X), ∃ (y : X), ¬ y = x) (x : X) : ¬ t.is_open {x} :=
begin
  by_contra w,
  rcases hX x with ⟨y, hy⟩,
  have minor₁ : is_open {x}ᶜ := is_open_compl_singleton,
  have : set.nonempty {x}ᶜ,
  { use y, rw [← ne.def, ← mem_compl_singleton_iff] at hy, exact hy, },
  exact (ne_empty_iff_nonempty.mpr $ nonempty_inter w (is_open_compl_singleton)
    (union_compl_self {x}) (set.singleton_nonempty x) this) (set.inter_compl_self {x}),
end

lemma accumulation_pt_of_mem_open_nondiscrete
  (X : Type*) [t : topological_space X] [cr : crowded_space X]
  {U : set X} (hU : is_open U) {z : X} (hz : z ∈ U) :
  accumulation_pt X U z :=
begin
  let ht := crowded_space.def X,
  intros V hV,
  rw is_open_iff_forall_mem_open at hU,
  rcases _root_.mem_nhds_iff.mp hV with ⟨V', hV'₁, hV'₂, hV'₃⟩,
  rcases hU z hz with ⟨U', hU'₁, hU'₂, hU'₃⟩,
  have : ¬ (U' ∩ V') = {z} := by_contra (λ h, ht z $ (not_not.mp h) ▸ is_open.inter hU'₂ hV'₂),
  rw set.ext_iff at this,
  simp at this,
  rcases this with ⟨v, hV⟩,
  use v,
  rw iff_iff_implies_and_implies at hV,
  cases not_and_distrib.mp hV,
  { simp at h,
    exact ⟨⟨hU'₁ h.1, hV'₁ h.2.1⟩, h.2.2⟩, },
  { simp at h,
    exfalso,
    exact h.2 (h.1.symm ▸ hU'₃) (h.1.symm ▸ hV'₃), },
end

lemma accumulation_pt_of_open_mem_frontier
  {X : Type*} [t : topological_space X] [cr : crowded_space X] {U : set X}
  (hU : is_open U) {z : X} (hz : z ∈ frontier U) :
  accumulation_pt X U z :=
if h : z ∈ U then accumulation_pt_of_mem_open_nondiscrete X hU h
  else begin
    rw accumulation_pt,
    intros V hV,
    let p := (mem_frontier X hz V hV).1,
    rcases set.nonempty_def.mp (set.ne_empty_iff_nonempty.mp p) with ⟨v, hv⟩,
    use v,
    have : ¬ v = z := begin
      by_contra w,
      rw ← w at h,
      exact h hv.2,
    end,
    rw set.inter_comm at hv,
    exact ⟨hv, this⟩,
  end

instance complex_plane_crowded_space : crowded_space ℂ :=
{ is_crowded := begin
    have : ∀ (x : ℂ), ∃ y, ¬ y = x :=
    begin
      intros x,
      by_cases (x = 0),
      { rw h,
        exact ⟨1, one_ne_zero⟩, },
      { exact ⟨0, λ h', h h'.symm⟩, },
    end,
    exact t1_space_connected_with_two_points_is_crowded ℂ this,
  end }

end crowded_space

section accuml_pts_homeomorph

lemma mem_image_closure_mem_closure
  {X : Type*} [topological_space X] {U : set X} {x : X} (hx : x ∈ closure U)
  {Y : Type*} [topological_space Y] {e : local_homeomorph X Y} (he : x ∈ e.to_local_equiv.source) :
  e x ∈ closure (e '' U) :=
begin
  rw _root_.mem_closure_iff at hx ⊢,
  intros o ho hxo,
  have : e.is_image (e⁻¹' o) o :=
  begin
    intros y hy,
    split,
    { intros h, exact h, },
    { intros h, exact set.mem_preimage.mp h },
  end,
  let o' := e.to_local_equiv.source ∩ e⁻¹' o,
  have subkey : x ∈ o' := ⟨he, hxo⟩,
  have key : is_open o' :=
    (local_homeomorph.is_image.is_open_iff this).mpr (is_open.inter e.open_target ho),
  rcases hx o' key subkey with ⟨z, hz₁, hz₂⟩,
  rcases hz₁ with ⟨hz₁₁, hz₁₂⟩,
  use e z,
  exact ⟨hz₁₂, set.mem_image_of_mem e hz₂⟩,
end

lemma mem_closure_inter
  {X : Type*} [topological_space X] {U : set X} {x : X} (hx : x ∈ closure U)
  {U' : set X} (hU' : is_open U') (h : x ∈ U') :
  x ∈ closure (U ∩ U') :=
begin
  rw _root_.mem_closure_iff at hx ⊢,
  intros o ho hxo,
  specialize hx (o ∩ U') (is_open.inter ho hU') ⟨hxo, h⟩,
  rw set.inter_assoc at hx,
  nth_rewrite 1 set.inter_comm at hx,
  exact hx,
end

lemma accumulation_pt_local_homeomorph
  {X : Type*} [topological_space X] {U : set X} {x : X} (hx : accumulation_pt X U x)
  {Y : Type*} [topological_space Y] {e : local_homeomorph X Y} (he : x ∈ e.to_local_equiv.source) :
  accumulation_pt Y (e '' U) (e x) :=
begin
  rw accumulation_pt at hx ⊢,
  intros V hV,
  rcases _root_.mem_nhds_iff.mp hV with ⟨V', hV'₁, hV'₂, hV'₃⟩,
  specialize hx (e.to_local_equiv.source ∩ e⁻¹' (V' ∩ e.to_local_equiv.target)),
  have : (e.to_local_equiv.source ∩ e⁻¹' (V' ∩ e.to_local_equiv.target)) ∈ 𝓝 x :=
  begin
    have minor : is_open (V' ∩ e.to_local_equiv.target) := is_open.inter hV'₂ e.open_target,
    have key : x ∈ (e⁻¹' (V' ∩ e.to_local_equiv.target)) := set.mem_preimage.mpr ⟨hV'₃, local_equiv.map_source _ he⟩,
    refine is_open.mem_nhds _ ⟨he, key⟩,
    apply local_homeomorph.preimage_open_of_open,
    exact is_open.inter hV'₂ e.open_target,
  end,
  rcases hx this with ⟨a, ha₁, ha₂⟩,
  rcases ha₁ with ⟨haa, hab⟩,
  let p := set.mem_image_of_mem e hab,
  use e a,
  split,
  { split, exact set.mem_image_of_mem e haa,
    nth_rewrite 1 set.inter_comm at p,
    rw [← local_homeomorph.coe_coe,
        ← local_equiv.symm_image_target_inter_eq e.to_local_equiv V'] at p,
    have : set.left_inv_on ⇑(e.to_local_equiv)
          ⇑(e.to_local_equiv.symm) e.to_local_equiv.target :=
    begin
      nth_rewrite 0 ← local_equiv.symm_symm e.to_local_equiv,
      rw [←local_homeomorph.symm_source, local_homeomorph.symm_to_local_equiv],
      exact local_equiv.left_inv_on e.to_local_equiv.symm,
    end,
    rw set.left_inv_on.image_image' this (set.inter_subset_left e.to_local_equiv.target V') at p,
    exact hV'₁ p.2, },
  rw set.mem_image at p,
  rcases p with ⟨b, hb⟩,
  rcases hb with ⟨left, right⟩,
  rcases left with ⟨hb₁, hb₂⟩,
  { intros w,
    have key : a = b := by rwa [eq_comm, ←local_homeomorph.coe_coe e,
          set.inj_on.eq_iff (local_equiv.inj_on e.to_local_equiv) hab.1 hb₁] at right,
    rw ← right at w,
    rw [eq_comm, ←local_homeomorph.coe_coe e,
        set.inj_on.eq_iff (local_equiv.inj_on e.to_local_equiv) he hb₁] at w,
    rw ← key at w,
    exact ha₂ (eq_comm.mp w), },
end

end accuml_pts_homeomorph

section complex_theorems

theorem identity_theorem
  {f : ℂ → ℂ} {g : ℂ → ℂ}
  {U : set ℂ} (hU₁ : is_open U) (hU₂ : is_connected U)
  (hf : differentiable_on ℂ f U) (hg : differentiable_on ℂ g U)
  {s₀ : ℂ} {S : set ℂ} (hS : S ⊆ U) (hS' : set.eq_on f g S)
  (hs₀ : s₀ ∈ S) (hs₀' : accumulation_pt ℂ S s₀):
  set.eq_on f g U :=
sorry

theorem eq_of_eq_on_open
  {f : ℂ → ℂ} {g : ℂ → ℂ}
  {U : set ℂ} (hU₁ : is_open U) (hU₂ : is_connected U)
  (hf : differentiable_on ℂ f U) (hg : differentiable_on ℂ g U)
  {V : set ℂ} (hV₁ : is_open V) (hV₂ : V.nonempty) (hV₃ : set.eq_on f g V) (hV₄ : V ⊆ U) :
  set.eq_on f g U :=
let ⟨v, hv⟩ := hV₂ in
  identity_theorem hU₁ hU₂ hf hg hV₄ hV₃ hv $ accumulation_pt_of_mem_open_nondiscrete ℂ hV₁ hv

theorem open_mapping_complex
  {f : ℂ → ℂ}
  {U : set ℂ} (hU₁ : is_open U) (hU₂ : is_connected U)
  (hf₁ : differentiable_on ℂ f U)
  (hf₂ : ∃ (x y : ℂ), x ∈ U ∧ y ∈ U ∧ ¬ f x = f y) :
  ∀ (U' : set ℂ), U' ⊆ U → is_open U' → is_open (f '' U'):=
sorry

end complex_theorems

/-
  Trash codes. A bad attempt to prove the identity theorem only assuming some
  standard results
-/

/-
lemma nonvanishing_has_local_expansion
(ε : ℝ) {hε : ε > 0}
(f : ℂ → ℂ)
(w : ℂ)
{hf₁ : ∃ (z : ℂ), z ∈ ball w ε ∧ ¬f z = 0}
{hf₂ : ∀ (z : ℂ), z ∈ ball w ε  → analytic_at ℂ f z} {hf₂ : f w = 0}:
∃ (k : ℕ) (r : ℝ) (g : ℂ → ℂ),
k > 0 ∧ r ≤ ε ∧ 0 < r ∧
∀ (x : ℂ), x ∈ ball w r → f = (λ x, ((x - w) ^ k) * g x)
∧ ¬ g x = 0 ∧ analytic_at ℂ g x:=
sorry

-- I cannot prove the following theorem neatly. I tried to prove it with some disguting inductions,
-- but Lean's treatments of derivatives are not quite nice in this case. Maybe using g's expansion
-- would be easier. But again, that requires at least one induction.
lemma nonvanishing_iter_deriv_of_nonvanishing
(f : ℂ → ℂ)
(w : ℂ)
{hf : analytic_at ℂ f w}:
(∃ (k : ℕ),
¬ iterated_deriv k f w = 0)
↔ (∃ (ε : ℝ), 0 < ε ∧ (∀ (z : ℂ), z ∈ ball w ε → analytic_at ℂ f z)
∧ (∃ (z : ℂ), z ∈ ball w ε ∧ ¬f z = 0)) :=
sorry

lemma nonvanishing_disk_of_continuous
(f : ℂ → ℂ)
(z : ℂ) {hf₁ : continuous_at f z} {hf₂ : ¬ f z = 0}:
∃ (ε : ℝ),
0 < ε ∧ ∀ (x : ℂ), x ∈ ball z ε → ¬ f x = 0 :=
begin
  have := hf₁,
  rw continuous_at_iff at this,
    let ε' := ∥f z∥ / 2,
    rw [← ne.def, ← norm_pos_iff] at hf₂,
    have hε' : 0 < ∥f z∥ / 2 := by linarith,
    rcases this ε' hε' with ⟨δ, hδ, h⟩,
    use min ε' δ,
    split,
    simp,
    exact ⟨hε', hδ⟩,
    {
      intros x hx,
      rw [mem_ball', dist_comm] at hx,
      have lt_δ : dist x z < δ := lt_of_lt_of_le hx (min_le_right _ _),
      specialize h lt_δ,
      rw [dist_eq_norm, norm_sub_rev] at h,
      have key : 0 < ∥f x∥ :=
        calc ∥f x∥ = ∥f z - (f z - f x)∥ : by simp
        ... ≥ ∥f z∥ - ∥f z - f x∥ : norm_sub_norm_le _ _
        ... ≥ ∥f z∥ - ε' : begin simp, apply le_of_lt, exact h, end
        ... ≥ ∥f z∥ - ∥f z∥ / 2 : begin simp, apply le_of_eq, rw ← norm_eq_abs, end
        ... = ∥f z∥ / 2 : by linarith
        ... > 0 : hε',
      rw [norm_pos_iff] at key,
      exact key,
    },
end

lemma is_open_nonvanishing_of_continuous
(f : ℂ → ℂ)
(U : set ℂ) {hU : is_open U}
{hf : ∀ (z : ℂ), z ∈ U → continuous_at f z} :
is_open {z : ℂ | z ∈ U ∧ ¬ f z = 0} :=
begin
  rw metric.is_open_iff at *,
  dsimp,
  intros z hz,
  rcases hz with ⟨hz₁, hz₂⟩,
  specialize hU z hz₁,
  specialize hf z hz₁,
  rcases hU with ⟨δ, hδ₁, hδ₂⟩,
  rcases nonvanishing_disk_of_continuous f z with ⟨ε, hε₁, hε₂⟩,
  assumption',
  use min δ ε,
  split,
  simp at hδ₁,
  exact lt_min hδ₁ hε₁,
  rw subset_def,
  dsimp,
  intros x hx,
  have key₁ : x ∈ U := hδ₂ ((ball_subset_ball $ min_le_left δ ε) hx),
  have key₂ : ¬ f x = 0 := hε₂ x ((ball_subset_ball $ min_le_right δ ε) hx),
  exact ⟨key₁, key₂⟩,
end

lemma isolated_zeros_of_nonvanishing
(ε : ℝ) {hε : ε > 0}
(f : ℂ → ℂ)
(w : ℂ)
{hf₁ : ∃ (z : ℂ), z ∈ ball w ε ∧ ¬f z = 0}
{hf₂ : ∀ (z : ℂ), z ∈ ball w ε  → analytic_at ℂ f z}:
∃ (r : ℝ),
r ≤ ε ∧ 0 < r ∧
∀ (x : ℂ), x ∈ ball w r → ¬ x - w = 0 → ¬ f x = 0:=
begin
  by_cases (f w = 0),
  -- the case where f w = 0; use f's local expansion around w
  {
    rcases nonvanishing_has_local_expansion ε f w with ⟨k, r, g, H⟩,
    rcases H with ⟨H₁, H₂, H₃, H₄⟩,
    use r,
    split,
    exact H₂,
    {
      split,
      exact H₃,
      {
        intros x hx₁ hx₂,
        by_contra h',
        specialize H₄ x hx₁,
        rcases H₄ with ⟨h₂₁, h₂₂, h₂₃⟩,
        rw h₂₁ at h',
        have key : (x - w) ^ k = 0 ∨ g x = 0 := eq_zero_or_eq_zero_of_mul_eq_zero h',
        cases key with key₁ key₂,
        {
          rw [← complex.cpow_nat_cast, complex.cpow_eq_zero_iff] at key₁,
          exact hx₂ key₁.1,
        },
        {
          exact h₂₂ key₂,
        },
      },
    },
    assumption',
  },
  -- the case where f w ≠ 0; use the continuity of f at w
  {
    specialize hf₂ w (mem_ball_self hε),
    rcases nonvanishing_disk_of_continuous f w with ⟨r, hr⟩,
    assumption',
    use min r ε,
    split,
    exact min_le_right _ _,
    split,
    {
      simp,
      exact ⟨hr.1, hε⟩,
    },
    {
      intros x hx₁ hx₂,
      rw [mem_ball'] at hx₁,
      have key : dist w x < r := lt_of_lt_of_le hx₁ (min_le_left _ _),
      rw [← mem_ball'] at key,
      exact hr.2 x key,
    },
    exact analytic_at.continuous_at hf₂,
  },
end

def is_accumulation_point (U : set ℂ) (z : ℂ) : Prop :=
∀ (V : set ℂ), V ∈ (𝓝 z) → ∃ (v : ℂ), v ∈ U ∩ V ∧ ¬ v - z = 0

lemma vanishing_disk_of_accumulation_point
(U : set ℂ) {hU : is_open U}
(f : ℂ → ℂ) {hf : ∀ (z : ℂ), z ∈ U → analytic_at ℂ f z}
(s₀ : ℂ)
{hs₀ : is_accumulation_point {s : ℂ | f s = 0 ∧ s ∈ U} s₀}
{hs₀' : s₀ ∈ {s : ℂ | f s = 0 ∧ s ∈ U}}:
∃ (ε : ℝ), 0 < ε ∧ ball s₀ ε ⊆ U ∧
∀ (z : ℂ), z ∈ ball s₀ ε → f z = 0 :=
begin
  by_contra w,
  simp only [not_exists, not_and] at w,
  dsimp at hs₀',
  rw metric.is_open_iff at hU,
  specialize hU s₀ hs₀'.2,
  rcases hU with ⟨ε, hε₁, hε₂⟩,
  specialize w ε hε₁ hε₂,
  simp only [not_forall] at w,
  rcases w with ⟨z, hz₁, hz₂⟩,
  have hf₁ : ∃ (z : ℂ), z ∈ ball s₀ ε ∧ ¬f z = 0 := ⟨z, ⟨hz₁, hz₂⟩⟩,
  have hf₂ : ∀ (x : ℂ), x ∈ ball s₀ ε → analytic_at ℂ f x := λ x hx, hf x $ hε₂ hx,
  rcases isolated_zeros_of_nonvanishing ε f s₀ with ⟨r, hr₁, hr₂, hr₃⟩,
  assumption',
  have : ∃ (v : ℂ), v ∈ {s : ℂ | f s = 0 ∧ s ∈ U} ∩ (ball s₀ r) ∧ ¬ v - s₀ = 0 :=
    hs₀ (ball s₀ r) (ball_mem_nhds s₀ hr₂),
  rcases this with ⟨v, hv₁, hv₂⟩,
  dsimp at hv₁,
  show false, from (hr₃ v hv₁.2 hv₂) hv₁.1.1,
end

theorem vanishing_if_zeros_accumulate
(U : set ℂ) {hU₁ : is_open U} {hU₂ : is_connected U}
(f : ℂ → ℂ) {hf : ∀ (z : ℂ), z ∈ U → analytic_at ℂ f z}
(s₀ : ℂ)
{hs₀ : is_accumulation_point {s : ℂ | f s = 0 ∧ s ∈ U} s₀}
{hs₀' : s₀ ∈ {s : ℂ | f s = 0 ∧ s ∈ U}}:
∀ (z : ℂ), z ∈ U → f z = 0:=
begin
  let U₁ : set ℂ := {z : ℂ | z ∈ U ∧ ∃ (r : ℝ), 0 < r ∧ ball z r ⊆ U ∧ ∀ (x : ℂ), x ∈ ball z r → f x = 0},
  let U₂ : set ℂ := {z : ℂ | z ∈ U ∧ ∃ (k : ℕ), ¬ iterated_deriv k f z = 0},
  have h₁ : U₁ ∪ U₂ = U :=
  begin
    ext,
    split,
    {
      intro h,
      dsimp at h,
      cases h with H₁ H₂,
      exact H₁.1,
      exact H₂.1,
    },
    {
      intro H,
      by_cases (x ∈ U₂),
      exact (mem_union_right U₁) h,
      {
        by_cases h' : f x = 0,
        {
          have key : is_accumulation_point {s : ℂ | f s = 0 ∧ s ∈ U} x ∧ x ∈ {s : ℂ | f s = 0 ∧ s ∈ U}:=
          begin
            by_contradiction w,
            rw not_and_distrib at w,
            cases w with w₁ w₂,
            {
              -- sorry,
              unfold is_accumulation_point at w₁,
              simp at w₁,
              rcases w₁ with ⟨U', hU₁', hU₂'⟩,
              rw metric.mem_nhds_iff at hU₁',
              rcases hU₁' with ⟨r, hr₁, hr₂⟩,
              let U'' : set ℂ := ball x r ∩ U,
              have key₁ : is_open U'' := is_open.inter metric.is_open_ball hU₁,
              rw metric.is_open_iff at key₁,
              specialize key₁ x (mem_inter (mem_ball_self hr₁) H),
              rcases key₁ with ⟨ε, hε₁, hε₂⟩,
              let x' : ℂ := x + ε / 2,
              have key₂ : x' ∈ ball x ε :=
              begin
                simp,
                have : 0 ≤ ε / 2 := by linarith,
                exact calc dist x' x = ∥(x + ε / 2) - x∥ : by rw dist_eq_norm
                  ... = complex.abs ↑(ε / 2) : by simp
                  ... = ε / 2 : by rw complex.abs_of_nonneg this
                  ... < ε : by linarith,
              end,
              have key₃ : ¬ f x' = 0 :=
              begin
                by_contra w',
                have : x' ∈ U'' := hε₂ key₂,
                simp only [mem_inter_eq] at this,
                specialize hU₂' x' w' this.2 (hr₂ this.1),
                have key : ¬ x' - x = 0 := begin
                  simp,
                  exact ne_of_gt hε₁,
                end,
                show false, from key hU₂',
              end,
              have : ∃ (ε : ℝ), ε > 0 ∧ (∀ (z : ℂ), z ∈ ball x ε → analytic_at ℂ f z) ∧ ∃ (z : ℂ), z ∈ ball x ε ∧ ¬f z = 0 :=
              begin
                use ε,
                split,
                exact hε₁,
                split,
                intros z hz,
                exact hf z (mem_of_mem_inter_right (hε₂ hz)),
                exact ⟨x', ⟨key₂, key₃⟩⟩,
              end,
              have key₄ : x ∈ U₂ :=
              begin
                dsimp,
                split,
                exact H,
                rcases iff.elim_right (nonvanishing_iter_deriv_of_nonvanishing f x) this with ⟨k, hk⟩,
                use k,
                exact hf x H,
              end,
              show false, from h key₄,
            },
            {
              simp at w₂,
              show false, from (w₂ h') H,
            },
          end,
          rcases vanishing_disk_of_accumulation_point U f x with ⟨ε, hε₁, hε₂, hε₃⟩,
          assumption',
          have : x ∈ U₁ :=
          begin
            dsimp [U₁],
            split,
            exact H,
            {
              use ε,
              exact ⟨hε₁, ⟨hε₂, hε₃⟩⟩,
            },
          end,
          exact (mem_union_left U₂) this,
          exact key.1,
          exact key.2,
        },
        {
          have key₁ : ∃ (k : ℕ), ¬ iterated_deriv k f x = 0 := by use 0,
          have key₂ : x ∈ U₂ := begin
            simp,
            exact ⟨H, key₁⟩,
          end,
          exfalso,
          exact h key₂,
        },
      },
    },
  end,
  have h₂ : U₁ ∩ U₂ = ∅ :=
  begin
    by_contra,
    rw [← ne.def, ne_empty_iff_nonempty, nonempty_def] at h,
    rcases h with ⟨x, hx⟩,
    dsimp at hx,
    rcases iff.elim_left (nonvanishing_iter_deriv_of_nonvanishing f x) hx.2.2 with ⟨ε, hε₁, hε₂, hε₃⟩,
    rcases isolated_zeros_of_nonvanishing ε f x with ⟨r, hr₁, hr₂, hr₃⟩,
    assumption',
    swap,
    exact hf x hx.1.1,
    rcases hx.1.2 with ⟨r', hr₁', hr₂', hr₃'⟩,
    let r'' : ℝ := min r r',
    have minor₁ : 0 < r'' :=
    begin
      rw lt_min_iff,
      exact ⟨hr₂, gt.lt hr₁'⟩,
    end,
    have minor₂ : ∃ (x' : ℂ), x' ∈ ball x r'' ∧ ¬ x' - x = 0 :=
    begin
      let x' : ℂ := x + r'' / 2,
      use x',
      split,
      simp only [metric.mem_ball],
      have : 0 ≤ r'' / 2 := by linarith,
      exact calc dist x' x = ∥(x + r'' / 2) - x∥ : by rw dist_eq_norm
        ... = complex.abs ↑(r'' / 2) : by simp
        ... = r'' / 2 : by rw complex.abs_of_nonneg this
        ... < r'' : by linarith,
      simp,
      exact ne_of_gt minor₁,
    end,
    rcases minor₂ with ⟨x', hx₁', hx₂'⟩,
    have key₁ : f x' = 0 := hr₃' x' ((ball_subset_ball (min_le_right r r')) hx₁'),
    have key₂ : ¬ f x' = 0 := hr₃ x' ((ball_subset_ball (min_le_left r r')) hx₁') hx₂',
    show false, from key₂ key₁,
  end,
  have h₃ : is_open U₁ :=
  begin
    rw metric.is_open_iff,
    intros x hx,
    dsimp at hx,
    rcases hx with ⟨hx₁, ε, hε₁, hε₂, hε₃⟩,
    use ε,
    split,
    exact hε₁,
    intros z hz,
    dsimp,
    split,
    exact hε₂ hz,
    have : ∃ (r : ℝ), (0 < r ∧ ball z r ⊆ U) ∧ ball z r ⊆ ball x ε :=
    begin
      have key : is_open (ball x ε) := is_open_ball,
      rw metric.is_open_iff at key,
      specialize key z hz,
      rcases key with ⟨r, hr₁, hr₂⟩,
      use r,
      split,
      exact ⟨hr₁, subset.trans hr₂ hε₂⟩,
      exact hr₂,
    end,
    rcases this with ⟨r, hr₁, hr₂⟩,
    use r,
    split,
    exact hr₁.1,
    split,
    exact hr₁.2,
    intros x' hx',
    exact hε₃ x' (hr₂ hx'),
  end,
  have h₄ : is_open U₂ :=
  begin
    sorry,
  end,
  have h₅ : U₁.nonempty :=
  begin
    rw nonempty_def,
    use s₀,
    dsimp,
    simp at hs₀',
    split,
    exact hs₀'.2,
    rcases vanishing_disk_of_accumulation_point U f s₀ with ⟨ε, hε₁, hε₂, hε₃⟩,
    assumption',
    use ε,
    exact ⟨hε₁, ⟨hε₂, hε₃⟩⟩,
  end,
  have hfinal : U₁ = U :=
  begin
    have : is_preconnected U := is_connected.is_preconnected hU₂,
    rw is_preconnected_iff_subset_of_disjoint at this,
    specialize this U₁ U₂ h₃ h₄ (eq.subset (eq.symm h₁)),
    have minor : U ∩ (U₁ ∩ U₂) = ∅ :=
    begin
      rw h₂,
      simp,
    end,
    specialize this minor,
    cases this,
    {
      have minor' : U₁ ⊆ U :=
      begin
        let h := set.subset_union_left U₁ U₂,
        rw h₁ at h,
        exact h,
      end,
      exact has_subset.subset.antisymm minor' this,
    },
    {
      have minor₁ : U₁ ⊆ U :=
      begin
        let h := set.subset_union_left U₁ U₂,
        rw h₁ at h,
        exact h,
      end,
      have minor₂ : U₂ ⊆ U :=
      begin
        let h := set.subset_union_right U₁ U₂,
        rw h₁ at h,
        exact h,
      end,
      have minor₃ : U₂ = U := has_subset.subset.antisymm minor₂ this,
      have key : U₁ = ∅ :=
      begin
        rw [inter_comm, ← set.subset_empty_iff, ← set.diff_eq_self] at h₂,
        rw ← h₂,
        by_contra w,
        rw [← ne.def, set.ne_empty_iff_nonempty, set.nonempty_diff, minor₃] at w,
        show false, from w minor₁,
      end,
      rw [← set.not_nonempty_iff_eq_empty] at key,
      exfalso,
      exact key h₅,
    },
  end,
  intros z hz,
  have : z ∈ U₁ := (eq.subset (eq.symm hfinal)) hz,
  dsimp at this,
  rcases this.2 with ⟨r, hr₁, hr₂, hr₃⟩,
  specialize hr₃ z (mem_ball_self hr₁),
  exact hr₃,
end

theorem eq_if_eq_points_accumulate
(U : set ℂ) {hU₁ : is_open U} {hU₂ : is_connected U}
(f : ℂ → ℂ) {hf : ∀ (z : ℂ), z ∈ U → analytic_at ℂ f z}
(g : ℂ → ℂ) {hg : ∀ (z : ℂ), z ∈ U → analytic_at ℂ g z}
(s₀ : ℂ)
{hs₀ : is_accumulation_point {s : ℂ | f s = g s ∧ s ∈ U} s₀}
{hs₀' : s₀ ∈ {s : ℂ | f s = g s ∧ s ∈ U}} :
∀ (z : ℂ), z ∈ U → f z = g z :=
begin
  let h : ℂ → ℂ := f - g,
  have minor : ∀ (z : ℂ), z ∈ U → analytic_at ℂ h z := λ z hz, analytic_at.sub (hf z hz) $ hg z hz,
  have key : {s : ℂ | f s = g s ∧ s ∈ U} = {s : ℂ | h s = 0 ∧ s ∈ U} :=
  begin
    ext,
    split,
    {
      intros hx,
      dsimp at hx,
      simp, split,
      exact calc h x = (f - g) x : by refl
        ... = f x - g x : by simp
        ... = f x - f x : by rw ← hx.1
        ... = 0 : by ring,
      exact hx.2,
    },
    {
      intros hx,
      dsimp at hx,
      simp, split,
      exact calc f x = f x - g x + g x : by simp
        ... = (f - g) x + g x : by simp
        ... = h x + g x : by refl
        ... = 0 + g x : by rw hx.1
        ... = g x : by ring,
      exact hx.2,
    },
  end,
  rw key at hs₀ hs₀',
  intros z hz,
  have : h z = 0 := vanishing_if_zeros_accumulate U h s₀ z hz,
  assumption',
  exact calc f z = f z - g z + g z : by simp
        ... = (f - g) z + g z : by simp
        ... = h z + g z : by refl
        ... = 0 + g z : by rw this
        ... = g z : by ring,
end
-/