/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import order.filter.basic
import topology.bases
import order.bounded_lattice
import formal_ml.set
import data.real.basic
import data.finset
import formal_ml.classical

open finset

/-
  There are more theorems about finsets in mathlib in data.finset.basic
-/
--Noncomputability is probably unavoidable, one way or another.
noncomputable def set_fintype_finset (T:Type) (F:fintype T) (S:set T):finset T :=
  @finset.filter T S (classical_set T S) F.elems

lemma set_fintype_finset_mem (T:Type) (F:fintype T) (S:set T) (a:T):
  a∈ S ↔  a∈ (set_fintype_finset T F S) :=
begin
  unfold set_fintype_finset,
  apply iff.symm,
  apply iff.trans,
  apply finset.mem_filter,
  split,
  {
     intros a_1,
     cases a_1,
     assumption,
  },
  {
    intros,
    split,
    {
      apply F.complete,
    },
    {
      assumption,
    }
  }
end

lemma empty_set_to_empty_finset (T:Type) (F:fintype T):
  set_fintype_finset T F ∅ = ∅ :=
begin
  ext,
  apply iff.symm,
  apply (set_fintype_finset_mem T F ∅),
end

--TODO:replace with finset.range_zero
lemma finset_zero:range 0 = ∅  :=
begin
  apply finset.range_zero,
end

--TODO:replace with finset.mem_range
lemma mem_finset_intro (n m:ℕ) :(n < m) → n ∈ range (m)  :=
begin
  apply (@finset.mem_range m n).mpr,
end

--TODO:replace with finset.mem_range
lemma mem_finset_elim (n m:ℕ) :n ∈ range (m) → (n < m) :=
begin
  apply (@finset.mem_range m n).mp,
end

--TODO:replace with finset.range_succ
lemma finset_succ (n:ℕ):range (nat.succ n) = insert n (range n)  :=
begin
  apply finset.range_succ,
end

--Trivial, but novel?
lemma finset_bot_eq_empty (T:Type) (D:decidable_eq T):
  @semilattice_inf_bot.bot (finset T) _ = ∅ :=
begin
  refl
end

--Novel?
lemma not_new_insert (P:Type) (D:decidable_eq P) (S:finset P) (p p':P):
  (p'∈ insert p S) → (p ≠ p') → (p' ∈ S) :=
begin
  intros A1 A2,
  rw finset.mem_insert at A1,
  cases A1 with A1 A1,
  {exfalso, apply A2, rw A1},
  {apply A1},
end

--TODO:replace with finset.mem_insert
lemma insert_or (P:Type) (D:decidable_eq P) (S:finset P) (p p':P):
  (p'∈ insert p S) → (p' = p) ∨ (p' ∈ S) :=
begin
  apply finset.mem_insert.mp,
end

--TODO:replace with finset.mem_insert_of_mem
lemma insert_intro (P:Type*) (D:decidable_eq P) (S:finset P) (p p':P):
  (p' ∈ S) → (p'∈ insert p S) :=
begin
  apply finset.mem_insert_of_mem,
end

--TODO:replace with finset.mem_insert_self
lemma insert_intro2 (P:Type*) (D:decidable_eq P) (S:finset P) (p:P):
  (p∈ insert p S) :=
begin
  intros,
  rw finset.insert_def,
  simp,
end

--TODO:replace with finset.disjoint_iff_inter_eq_empty or disjoint_iff.
lemma finset_disjoint_def (T:Type*) (D:decidable_eq T)  (A B:finset T):
  disjoint A B ↔ A ∩ B ⊆ ∅ :=
begin
  refl,
end

--TODO:replace with finset.disjoint_iff_inter_eq_empty.
lemma finset_disjoint_def_fwd (T:Type*) (D:decidable_eq T)  (A B:finset T):
  disjoint A B → A ∩ B ⊆ ∅ :=
begin
  rw finset.disjoint_iff_inter_eq_empty,
  intros A1,
  rw A1,
  simp,
end

lemma finset_disjoint_def_bck (T:Type*) (D:decidable_eq T)  (A B:finset T):
  A ∩ B ⊆ ∅ → disjoint A B :=
begin
  rw finset.disjoint_iff_inter_eq_empty,
  intro A1,
  apply finset.subset.antisymm,
  apply A1,
  simp,
end

--TODO: replace with finset.max (but defn slightly different).
def finset_max (A:finset ℕ):ℕ :=
  (@finset.fold ℕ ℕ max _ _  0  id A)

lemma finset_max_def (A:finset ℕ):
  (finset_max A)  = (fold  max 0  id A) :=
begin
  refl,
end

lemma finset_max_limit (A:finset ℕ) (a:ℕ):
  (a∈ A)→ (a ≤ (finset_max A)) :=
begin
  apply finset.induction_on A,
  {
    simp,
  },
  {
    intros a_1 s B1 B2 B3,
    have A1:a = a_1 ∨ a∈ s,
    {
      apply insert_or,
      assumption,
    },
    rw finset_max_def,
    rw finset.fold_insert_idem,
    rw ← finset_max_def,
    simp,
    cases A1,
    {
      subst a_1,
      left,
      refl,
    },
    {
      right,
      apply B2,
      apply A1,
    }
  }
end

--This seems useful. It is probably in mathlib somewhere.
lemma finset_range_bound (A:finset ℕ):∃ n, (A⊆ finset.range n) :=
begin
  apply exists.intro (nat.succ (finset_max A)),
  rw finset.subset_iff,
  intros x a,
  apply mem_finset_intro,
  have A1:x ≤ finset_max A,
  {
    apply finset_max_limit,
    apply a,
  },
  apply lt_of_le_of_lt,
  {
    apply A1,
  },
  {
    apply nat.lt_succ_self,
  }
end

--TODO: replace with finset.range_subset.mpr
lemma finset_range_monotonic (m n:ℕ):(m ≤ n) → (finset.range m ⊆ finset.range n) :=
begin
  apply finset.range_subset.mpr,
end

--TODO: replace with finset.disjoint_left
lemma finset_disjoint_intro {α:Type*} [decidable_eq α] (S T:finset α):(∀ a∈ S, a∉ T)→ (disjoint S T) :=
begin
  intros A1,
  rw finset.disjoint_left,
  apply A1,
end

--If this doesn't exist, it should definitely be added.
lemma finset_disjoint_symm {α:Type*} [decidable_eq α] (S T:finset α):(disjoint S T)→ (disjoint T S) :=
begin
  intros,
  apply (finset_disjoint_def α _ T S).mpr,
  rw finset.inter_comm,
  apply (finset_disjoint_def α _ S T).mp,
  assumption
end

--TODO: replace with finset.disjoint_left or finset.disjoint_right
lemma finset_disjoint_elim {α:Type*} [X:decidable_eq α] {S T:finset α} (a:α):(disjoint S T)→
    (a∈ S)→ (a∉ T) :=
begin
  rw finset.disjoint_left,
  intros A1 A2,
  apply A1 A2,
end

--TODO: replace with finset.disjoint_insert_right
lemma insert_disjoint_imp_disjoint {α:Type*} [decidable_eq α] (S T:finset α) (a:α):
  disjoint T (insert a S) → disjoint T S :=
begin
  intros A1,
  rw finset.disjoint_insert_right at A1,
  apply A1.right,
end

lemma sum_insert_add {α β:Type*} [decidable_eq α] [add_comm_monoid β] (f:α → β) (S:finset α) (a:α):
  (a∉ S)→
  (((insert a S).sum  f)=(f a) + (S.sum f)) :=
begin
  intros a_1,
  apply fold_insert,
  apply a_1,
end

--TODO: replace with finset.sdiff_subset
lemma sdiff_subset {α:Type*} [decidable_eq α] (S T:finset α):(S \ T) ⊆ S :=
begin
  apply finset.sdiff_subset,
end

lemma sum_disjoint_add {α β:Type*} [decidable_eq α] [add_comm_monoid β] (f:α → β) (S T:finset α):
  disjoint S T →
  ((S.sum f) + (T.sum f)=(S∪ T).sum  f) :=
begin
  apply finset.induction_on T,
  {
    simp,
  },
  {
    intros a s B1 B2 B3,
    simp,
    have A1:disjoint S s,
    {
      apply insert_disjoint_imp_disjoint,
      apply B3,
    },
    have A2:a∉ S,
    {
      have A3:disjoint (insert a s) S,
      {
        apply finset_disjoint_symm,
        apply B3,
      },
      apply finset_disjoint_elim,
      apply A3,
      apply insert_intro2,
    },
    rw sum_insert_add,
    rw sum_insert_add,
    have A2:S.sum f + s.sum f =  (S ∪ s).sum f,
    {
      apply B2,
      apply A1,
    },
    rw ← A2,
    rw ← add_assoc,
    rw add_comm _ (f a),
    simp,
    apply add_assoc,
    rw finset.mem_union,
    intro a_4,
    cases a_4,
    {
      apply A2,
      apply a_4,
    },
    {
      apply B1,
      apply a_4,
    },
    assumption,
  }
end

def finset_set {α:Type*} (S:finset α) (a:α):Prop := a∈ S

--def finset_type {α:Type*} (S:finset α):Type* := subtype (λ a:α, a ∈ S)

lemma finset_fintype_complete {α:Type*} (S:finset α):∀ a:{a:α|a∈ S}, a∈ (finset.attach S) :=
begin
  intros,
  unfold attach,
  simp,
end

def finset_fintype {α:Type*} (S:finset α):fintype {a:α|a∈ S} := {
  elems := finset.attach S,
  complete :=  finset_fintype_complete S,
}

lemma finite_finset {α:Type*} (S:finset α):set.finite {a:α| a∈ S} :=
begin
  unfold set.finite,
  apply nonempty.intro (finset_fintype S),
end

def finset.Union {α:Type*} [decidable_eq α] (S:finset (finset α)):finset α :=
  finset.fold (@has_union.union (finset α) _) (∅:finset α) id S

def finset.Union_insert {α:Type*} [decidable_eq α] (S:finset (finset α)) (t:finset α):
  finset.Union (insert t S) = t ∪ finset.Union S :=
begin
  unfold finset.Union,
  simp,
end

lemma finset.mem_Union {α:Type*} [decidable_eq α] (S:finset (finset α)) {a:α}:
  a ∈ S.Union  ↔ (∃ (T:finset α), a∈ T ∧ T ∈ S) :=
begin
  split,
  {
    apply finset.induction_on S,
    {
      unfold finset.Union,simp,
    },
    {
      intros T S',
      intros C1 C2 C3,
      rw finset.Union_insert at C3,
      simp at C3,
      cases C3 with C3 C3,
      {
        apply exists.intro T,
        simp [C3],
      },
      {
        have C4 := C2 C3,
        cases C4 with T C4,
        apply exists.intro T,
        simp [C4],
      },
    },
  },
  {
    apply finset.induction_on S,
    {
      --intros A1,
      simp,
    },
    {
      intros T S' D1 D2 D3,
      rw finset.Union_insert,
      cases D3 with T' D3,
      cases D3 with D3 D4,
      simp at D4,
      cases D4 with D4 D4,
      {
        subst T',
        simp [D3],
      },
      {
        simp,
        right,
        apply D2,
        apply exists.intro T',
        apply and.intro D3 D4,
      },
    },
  },
end

--Cool, but unused.
/-
  Constructs a finset {u:finset α|∃ s∈ S, t∈ T, u = s ∪ t}
 -/
def finset.pairwise_union {α:Type*} [decidable_eq α] (S T:finset (finset α)):finset (finset α)
  := finset.Union (finset.image (λ s:finset α, finset.image (λ t:finset α, s ∪ t) T) S)

lemma finset.mem_pairwise_union {α:Type*} [decidable_eq α] (S T:finset (finset α)) (z:finset α):
  z ∈ finset.pairwise_union S T ↔ ∃ (s t:finset α), s∈ S ∧ t ∈ T ∧ z = s ∪ t :=
begin
  unfold finset.pairwise_union,
  rw finset.mem_Union,
  split;intros B1,
  {
    cases B1 with T' B1,
    cases B1 with B1 B2,
    simp at B2,
    cases B2 with s B2,
    cases B2 with B2 B3,
    subst T',
    simp at B1,
    cases B1 with t B1,

    apply exists.intro s,
    apply exists.intro t,
    simp [B1,B2],
  },
  {
    cases B1 with s B1,
    cases B1 with t B1,
    apply exists.intro (finset.image (λ (t : finset α), s ∪ t) T),
    simp,
    split,
    {
      apply exists.intro t,
      simp [B1],
    },
    {
      apply exists.intro s,
      simp [B1],
    },
  },
end

lemma finset.mem_union_pairwise_union_of_mem {α:Type*} [decidable_eq α] (S T:finset (finset α))
  (s t:finset α):(s∈ S) → (t ∈ T) → (s ∪ t) ∈ finset.pairwise_union S T :=
begin
  intros A1 A2,
  rw finset.mem_pairwise_union,
  apply exists.intro s,
  apply exists.intro t,
  simp [A1,A2],
end

lemma finset.pairwise_union.comm {α:Type*} [decidable_eq α] (A B:finset (finset α)):
  finset.pairwise_union A B = finset.pairwise_union B A :=
begin
  ext a,
  rw finset.mem_pairwise_union,
  rw finset.mem_pairwise_union,
  split;
  {
    intros B1,cases B1 with s B1,cases B1 with t B1,
    apply exists.intro t,apply exists.intro s,simp [B1,finset.union_comm],
  },
end

lemma finset.pairwise_union.assoc {α:Type*} [decidable_eq α] (A B C:finset (finset α)):
 finset.pairwise_union (finset.pairwise_union A B) C =
  finset.pairwise_union A (finset.pairwise_union B C) :=
begin
  ext x,
  --rw finset.mem_pairwise_union,
  --rw finset.mem_pairwise_union,
  split,
  {
    intro B1,
    rw finset.mem_pairwise_union at B1,
    cases B1 with ab B1,
    cases B1 with c B1,
    cases B1 with B1 B2,
    cases B2 with B2 B3,
    subst x,
    rw finset.mem_pairwise_union at B1,
    cases B1 with a B1,
    cases B1 with b B1,
    cases B1 with B1 B3,
    cases B3 with B3 B4,
    subst ab,
    rw finset.union_assoc,
    repeat {apply finset.mem_union_pairwise_union_of_mem},
    repeat {assumption},
  },
  {
    intros B1,
    rw finset.mem_pairwise_union at B1,
    cases B1 with a B1,
    cases B1 with bc B1,
    cases B1 with B1 B2,
    cases B2 with B2 B3,
    subst x,
    rw finset.mem_pairwise_union at B2,
    cases B2 with b B2,
    cases B2 with c B2,
    cases B2 with B2 B3,
    cases B3 with B3 B4,
    subst bc,
    rw ← finset.union_assoc,
    repeat {apply finset.mem_union_pairwise_union_of_mem},
    repeat {assumption},
  },
end

instance finset.pairwise_union.is_commutative {α:Type*} [D:decidable_eq α]:
  is_commutative (finset (finset α)) (@finset.pairwise_union α D) := {
  comm := finset.pairwise_union.comm
}

instance finset.pairwise_union.is_associative {α:Type*} [D:decidable_eq α]:
  is_associative (finset (finset α)) (@finset.pairwise_union α D) := {
  assoc := finset.pairwise_union.assoc
}

lemma finset.union_diff {α:Type*} [decidable_eq α] {S T:finset α}:S⊆T →
  S ∪ T \ S = T :=
begin
  intros A1,
  ext a,
  split;intros B1,
  {
    simp at B1,
    cases B1,
    apply A1,
    apply B1,
    apply B1,
  },
  {
    simp,
    apply or.inr B1,
  },
end

lemma finset.diff_subset_insert {α:Type*} [decidable_eq α] {T S:finset α} {a:α}:T ⊆ insert a S  →
   (T \ {a}) ⊆ S :=
begin
  intros A1,
  rw finset.subset_iff,
  rw finset.subset_iff at A1,
  intros x B1,
  simp at B1,
  have B2 := A1 B1.left,
  simp at B2,
  simp [B1] at B2,
  apply B2,
end

lemma finset.subset_insert_of_not_mem {α:Type*} [decidable_eq α] {T S:finset α} {a:α}:a∉ T →
   T ⊆ insert a S  → T ⊆ S :=
begin
  intros A1 A2,
  rw finset.subset_iff,
  intros x B1,
  --simp at A2,
  have B2 := A2 B1,
  simp at B2,
  cases B2,
  {
    subst x,
    exfalso,
    apply A1 B1,
  },
  {
    apply B2,
  },
end

--Probably already exists.
lemma finset.singleton_union_eq_insert {α:Type*} [D:decidable_eq α] {a:α} {S:finset α}:{a} ∪ S =
  insert a S :=
begin
  refl
end

lemma finset.Union_insert' {α β:Type*}
    [D:decidable_eq β] {f:β → set α} {b:β} {S:finset β}:
   (⋃ (b':β) (H:b'∈ (insert b S)), f b') =
   (f b) ∪ (⋃ (b':β) (H:b'∈ S), f b') :=
begin
  simp
end

lemma finset.powerset_singleton {α:Type*}[decidable_eq α] {x:α}:@finset.powerset α {x} = {∅,{x}} :=
begin
  have B1:{x} = insert x (∅:finset α),
  refl,
  rw B1,
  rw finset.powerset_insert,
  refl,
end

lemma finset.subset_of_not_mem_of_subset_insert {α:Type*} [decidable_eq α] {x:α} {S T:finset α}:x∉ S →
  S ⊆ insert x T → S ⊆ T :=
begin
  intros A1 A2,
  rw finset.subset_iff,
  rw finset.subset_iff at A2,
  intros a B1,
  have B2 := A2 B1,
  rw finset.mem_insert at B2,
  cases B2,
  subst a,
  exfalso,
  apply A1,
  apply B1,
  apply B2,
end

def finset.to_set_of_sets {α:Type*} (C:finset (finset α)):set (set α) :=
  (λ c:finset α, (↑c:set α)) '' (↑C:set (finset α))

lemma finset.mem_to_set_of_sets {α:Type*} {C:finset (finset α)} {c:finset α}:
  (↑c ∈ (C.to_set_of_sets)) ↔ c ∈ C :=
begin
  unfold finset.to_set_of_sets,
  simp,
end

lemma finset.mem_to_set_of_sets' {α:Type*} {C:finset (finset α)} {c:set α}:
  c∈ C.to_set_of_sets ↔ ∃ c' ∈ C, c=(↑c') :=
begin
  unfold finset.to_set_of_sets,
  split;intro A1,
  {
    simp at A1,
    cases A1 with c' A1,
    apply exists.intro c',
    apply exists.intro A1.left,
    rw A1.right,
  },
  {
    simp,
    cases A1 with c' A1,
    apply exists.intro c',
    cases A1 with A1 A2,
    simp [A1, A2],
  },
end

--Note: S could be either empty or have a unique element.
lemma finset.card_identical_elements {α:Type*} [decidable_eq α] {S:finset α}:
   (∀ a b:α,  a ∈ S → b ∈ S → a=b ) → S.card ≤ 1 :=
begin
  --intros A1,
  apply finset.induction_on S,
  {
    simp,
  },
  {
    intros a s B1 B2 B3,
    have C1:s = ∅,
    {
      rw ← finset.subset_empty,
      rw finset.subset_iff,
      intros b C1A,
      exfalso,
      apply B1,
      have C1B:a = b,
      {
        apply B3;simp [C1A],
      },
      rw C1B,
      apply C1A,
    },
    rw C1,
    simp,
  },
end

lemma finset.eq_of_insert_of_not_mem {α:Type*} [decidable_eq α] {A B:finset α} {x:α}:(x∉ A) → (x∉ B) → (insert x A  = insert x B)
  → A = B :=
begin
  intros A1 A3 A2,
  ext a;split;intros B1;have C1 := finset.mem_insert_of_mem B1,
  {
    rw A2 at C1,
    apply finset.mem_of_mem_insert_of_ne C1,
    intros C2,
    subst a,
    apply A1 B1,
  },
  {
    rw ← A2 at C1,
    apply finset.mem_of_mem_insert_of_ne C1,
    intros C2,
    subst a,
    apply A3 B1,
  },
end

lemma finset.insert_inter_eq_insert_inter_insert {α:Type*} [decidable_eq α]
  {S T:finset α} {a:α}:(insert a S) ∩ (insert a T) = insert a (S ∩ T) :=
begin
  ext b,
  split;intros A1,
  {
    rw finset.mem_insert,
    simp at A1,
    cases A1,
    subst a,
    simp,
    cases A1 with A1 A2,
    cases A1 with A1 A1,
    apply or.inl A1,
    simp [A1,A2],
  },
  {
    simp,
    simp at A1,
    cases A1 with A1 A1,
    apply or.inl A1,
    simp [A1],
  },
end

lemma finset.exists_subset_card {α:Type*} [decidable_eq α] {S:finset α} {n:ℕ} (h:n ≤ S.card):∃ T:finset α, T.card = n ∧ T ⊆ S :=
begin
  --revert h,
  revert n,

  apply finset.induction_on S,
  { intros n h, simp at h, subst h, apply exists.intro ∅,
    simp, split, refl, apply finset.subset.refl },
  { intros a s h_not_mem h_ind n h,
    simp [h_not_mem] at h,
    cases decidable.em (n = s.card + 1) with h_eq h_ne,
    apply exists.intro (insert a s),
    split,
    simp [h_not_mem],
    rw h_eq,
    apply finset.subset.refl,
    have h_lt_succ:n < s.card + 1,
    { rw lt_iff_le_and_ne, simp [h, h_ne] },
    have h_n_le_card := nat.le_of_lt_succ h_lt_succ,
    have h_ind' := h_ind h_n_le_card,
    cases h_ind' with T h_ind',
    apply exists.intro T,
    simp [h_ind'],
    apply finset.subset.trans h_ind'.right,
    apply finset.subset_insert },
end

#check finset.inter_subset_inter


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.analysis.filter
import topology.bases
import topology.locally_finite

/-!
# Computational realization of topological spaces (experimental)

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

This file provides infrastructure to compute with topological spaces.

## Main declarations

* `ctop`: Realization of a topology basis.
* `ctop.realizer`: Realization of a topological space. `ctop` that generates the given topology.
* `locally_finite.realizer`: Realization of the local finiteness of an indexed family of sets.
* `compact.realizer`: Realization of the compactness of a set.
-/

open set
open filter (hiding realizer)
open_locale topology

/-- A `ctop α σ` is a realization of a topology (basis) on `α`,
  represented by a type `σ` together with operations for the top element and
  the intersection operation. -/
structure ctop (α σ : Type*) :=
(f : σ → set α)
(top : α → σ)
(top_mem : ∀ x : α, x ∈ f (top x))
(inter : Π a b (x : α), x ∈ f a ∩ f b → σ)
(inter_mem : ∀ a b x h, x ∈ f (inter a b x h))
(inter_sub : ∀ a b x h, f (inter a b x h) ⊆ f a ∩ f b)

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

instance : inhabited (ctop α (set α)) :=
⟨{ f := id,
  top := singleton,
  top_mem := mem_singleton,
  inter := λ s t _ _, s ∩ t,
  inter_mem := λ s t a, id,
  inter_sub := λ s t a ha, subset.rfl }⟩

namespace ctop
section
variables (F : ctop α σ)

instance : has_coe_to_fun (ctop α σ) (λ _, σ → set α) := ⟨ctop.f⟩

@[simp] theorem coe_mk (f T h₁ I h₂ h₃ a) : (@ctop.mk α σ f T h₁ I h₂ h₃) a = f a := rfl

/-- Map a ctop to an equivalent representation type. -/
def of_equiv (E : σ ≃ τ) : ctop α σ → ctop α τ
| ⟨f, T, h₁, I, h₂, h₃⟩ :=
  { f         := λ a, f (E.symm a),
    top       := λ x, E (T x),
    top_mem   := λ x, by simpa using h₁ x,
    inter     := λ a b x h, E (I (E.symm a) (E.symm b) x h),
    inter_mem := λ a b x h, by simpa using h₂ (E.symm a) (E.symm b) x h,
    inter_sub := λ a b x h, by simpa using h₃ (E.symm a) (E.symm b) x h }

@[simp] theorem of_equiv_val (E : σ ≃ τ) (F : ctop α σ) (a : τ) :
  F.of_equiv E a = F (E.symm a) := by cases F; refl

end

/-- Every `ctop` is a topological space. -/
def to_topsp (F : ctop α σ) : topological_space α :=
topological_space.generate_from (set.range F.f)

theorem to_topsp_is_topological_basis (F : ctop α σ) :
  @topological_space.is_topological_basis _ F.to_topsp (set.range F.f) :=
by letI := F.to_topsp; exact
⟨λ u ⟨a, e₁⟩ v ⟨b, e₂⟩, e₁ ▸ e₂ ▸
   λ x h, ⟨_, ⟨_, rfl⟩, F.inter_mem a b x h, F.inter_sub a b x h⟩,
eq_univ_iff_forall.2 $ λ x, ⟨_, ⟨_, rfl⟩, F.top_mem x⟩, rfl⟩

@[simp] theorem mem_nhds_to_topsp (F : ctop α σ) {s : set α} {a : α} :
  s ∈ @nhds _ F.to_topsp a ↔ ∃ b, a ∈ F b ∧ F b ⊆ s :=
(@topological_space.is_topological_basis.mem_nhds_iff
  _ F.to_topsp _ _ _ F.to_topsp_is_topological_basis).trans $
⟨λ ⟨_, ⟨x, rfl⟩, h⟩, ⟨x, h⟩, λ ⟨x, h⟩, ⟨_, ⟨x, rfl⟩, h⟩⟩

end ctop

/-- A `ctop` realizer for the topological space `T` is a `ctop`
  which generates `T`. -/
structure ctop.realizer (α) [T : topological_space α] :=
(σ : Type*)
(F : ctop α σ)
(eq : F.to_topsp = T)
open ctop

/-- A `ctop` realizes the topological space it generates. -/
protected def ctop.to_realizer (F : ctop α σ) : @ctop.realizer _ F.to_topsp :=
@ctop.realizer.mk _ F.to_topsp σ F rfl

instance (F : ctop α σ) : inhabited (@ctop.realizer _ F.to_topsp) := ⟨F.to_realizer⟩

namespace ctop.realizer

protected theorem is_basis [T : topological_space α] (F : realizer α) :
  topological_space.is_topological_basis (set.range F.F.f) :=
by have := to_topsp_is_topological_basis F.F; rwa F.eq at this

protected theorem mem_nhds [T : topological_space α] (F : realizer α) {s : set α} {a : α} :
  s ∈ 𝓝 a ↔ ∃ b, a ∈ F.F b ∧ F.F b ⊆ s :=
by have := mem_nhds_to_topsp F.F; rwa F.eq at this

theorem is_open_iff [topological_space α] (F : realizer α) {s : set α} :
  is_open s ↔ ∀ a ∈ s, ∃ b, a ∈ F.F b ∧ F.F b ⊆ s :=
is_open_iff_mem_nhds.trans $ ball_congr $ λ a h, F.mem_nhds

theorem is_closed_iff [topological_space α] (F : realizer α) {s : set α} :
  is_closed s ↔ ∀ a, (∀ b, a ∈ F.F b → ∃ z, z ∈ F.F b ∩ s) → a ∈ s :=
is_open_compl_iff.symm.trans $ F.is_open_iff.trans $ forall_congr $ λ a,
show (a ∉ s → (∃ (b : F.σ), a ∈ F.F b ∧ ∀ z ∈ F.F b, z ∉ s)) ↔ _,
by haveI := classical.prop_decidable; rw [not_imp_comm];
   simp [not_exists, not_and, not_forall, and_comm]

theorem mem_interior_iff [topological_space α] (F : realizer α) {s : set α} {a : α} :
  a ∈ interior s ↔ ∃ b, a ∈ F.F b ∧ F.F b ⊆ s :=
mem_interior_iff_mem_nhds.trans F.mem_nhds

protected theorem is_open [topological_space α] (F : realizer α) (s : F.σ) : is_open (F.F s) :=
is_open_iff_nhds.2 $ λ a m, by simpa using F.mem_nhds.2 ⟨s, m, subset.refl _⟩

theorem ext [T : topological_space α] {σ : Type*} {F : ctop α σ}
  (H₁ : ∀ a, is_open (F a))
  (H₂ : ∀ a s, s ∈ 𝓝 a → ∃ b, a ∈ F b ∧ F b ⊆ s) :
  F.to_topsp = T :=
ext' $ λ a s, ⟨H₂ a s, λ ⟨b, h₁, h₂⟩, mem_nhds_iff.2 ⟨_, h₂, H₁ _, h₁⟩⟩

variable [topological_space α]

/-- The topological space realizer made of the open sets. -/
protected def id : realizer α := ⟨{x:set α // is_open x},
{ f            := subtype.val,
  top          := λ _, ⟨univ, is_open_univ⟩,
  top_mem      := mem_univ,
  inter        := λ ⟨x, h₁⟩ ⟨y, h₂⟩ a h₃, ⟨_, h₁.inter h₂⟩,
  inter_mem    := λ ⟨x, h₁⟩ ⟨y, h₂⟩ a, id,
  inter_sub    := λ ⟨x, h₁⟩ ⟨y, h₂⟩ a h₃, subset.refl _ },
ext subtype.property $ λ x s h,
  let ⟨t, h, o, m⟩ := mem_nhds_iff.1 h in ⟨⟨t, o⟩, m, h⟩⟩

/-- Replace the representation type of a `ctop` realizer. -/
def of_equiv (F : realizer α) (E : F.σ ≃ τ) : realizer α :=
⟨τ, F.F.of_equiv E, ext' (λ a s, F.mem_nhds.trans $
 ⟨λ ⟨s, h⟩, ⟨E s, by simpa using h⟩, λ ⟨t, h⟩, ⟨E.symm t, by simpa using h⟩⟩)⟩

@[simp] theorem of_equiv_σ (F : realizer α) (E : F.σ ≃ τ) : (F.of_equiv E).σ = τ := rfl
@[simp] theorem of_equiv_F (F : realizer α) (E : F.σ ≃ τ) (s : τ) :
  (F.of_equiv E).F s = F.F (E.symm s) := by delta of_equiv; simp

/-- A realizer of the neighborhood of a point. -/
protected def nhds (F : realizer α) (a : α) : (𝓝 a).realizer :=
⟨{s : F.σ // a ∈ F.F s},
{ f            := λ s, F.F s.1,
  pt           := ⟨_, F.F.top_mem a⟩,
  inf          := λ ⟨x, h₁⟩ ⟨y, h₂⟩, ⟨_, F.F.inter_mem x y a ⟨h₁, h₂⟩⟩,
  inf_le_left  := λ ⟨x, h₁⟩ ⟨y, h₂⟩ z h, (F.F.inter_sub x y a ⟨h₁, h₂⟩ h).1,
  inf_le_right := λ ⟨x, h₁⟩ ⟨y, h₂⟩ z h, (F.F.inter_sub x y a ⟨h₁, h₂⟩ h).2 },
filter_eq $ set.ext $ λ x,
⟨λ ⟨⟨s, as⟩, h⟩, mem_nhds_iff.2 ⟨_, h, F.is_open _, as⟩,
 λ h, let ⟨s, h, as⟩ := F.mem_nhds.1 h in ⟨⟨s, h⟩, as⟩⟩⟩

@[simp] lemma nhds_σ (F : realizer α) (a : α) : (F.nhds a).σ = {s : F.σ // a ∈ F.F s} := rfl
@[simp] lemma nhds_F (F : realizer α) (a : α) (s) : (F.nhds a).F s = F.F s.1 := rfl

theorem tendsto_nhds_iff {m : β → α} {f : filter β} (F : f.realizer) (R : realizer α) {a : α} :
  tendsto m f (𝓝 a) ↔ ∀ t, a ∈ R.F t → ∃ s, ∀ x ∈ F.F s, m x ∈ R.F t :=
(F.tendsto_iff _ (R.nhds a)).trans subtype.forall

end ctop.realizer

/-- A `locally_finite.realizer F f` is a realization that `f` is locally finite, namely it is a
choice of open sets from the basis of `F` such that they intersect only finitely many of the values
of `f`.  -/
structure locally_finite.realizer [topological_space α] (F : realizer α) (f : β → set α) :=
(bas : ∀ a, {s // a ∈ F.F s})
(sets : ∀ x:α, fintype {i | (f i ∩ F.F (bas x)).nonempty})

theorem locally_finite.realizer.to_locally_finite [topological_space α]
  {F : realizer α} {f : β → set α} (R : locally_finite.realizer F f) :
  locally_finite f :=
λ a, ⟨_, F.mem_nhds.2
  ⟨(R.bas a).1, (R.bas a).2, subset.refl _⟩, ⟨R.sets a⟩⟩

theorem locally_finite_iff_exists_realizer [topological_space α]
  (F : realizer α) {f : β → set α} : locally_finite f ↔ nonempty (locally_finite.realizer F f) :=
⟨λ h, let ⟨g, h₁⟩ := classical.axiom_of_choice h,
    ⟨g₂, h₂⟩ := classical.axiom_of_choice (λ x,
       show ∃ (b : F.σ), x ∈ (F.F) b ∧ (F.F) b ⊆ g x, from
       let ⟨h, h'⟩ := h₁ x in F.mem_nhds.1 h) in
  ⟨⟨λ x, ⟨g₂ x, (h₂ x).1⟩, λ x, finite.fintype $
    let ⟨h, h'⟩ := h₁ x in h'.subset $ λ i hi,
    hi.mono (inter_subset_inter_right _ (h₂ x).2)⟩⟩,
 λ ⟨R⟩, R.to_locally_finite⟩

instance [topological_space α] [finite β] (F : realizer α) (f : β → set α) :
  nonempty (locally_finite.realizer F f) :=
(locally_finite_iff_exists_realizer _).1 $ locally_finite_of_finite _

/-- A `compact.realizer s` is a realization that `s` is compact, namely it is a
choice of finite open covers for each set family covering `s`.  -/
def compact.realizer [topological_space α] (s : set α) :=
∀ {f : filter α} (F : f.realizer) (x : F.σ), f ≠ ⊥ →
  F.F x ⊆ s → {a // a∈s ∧ 𝓝 a ⊓ f ≠ ⊥}

instance [topological_space α] : inhabited (compact.realizer (∅ : set α)) :=
⟨λ f F x h hF, by { cases h _, rw [←F.eq, eq_bot_iff], exact λ s _, ⟨x, hF.trans s.empty_subset⟩ }⟩


import main
import split_cycle

open_locale classical

variables {V X : Type}

def minus_candidate (P : Prof V X) (b : X) : Prof V {x : X // x ≠ b} := λ v x y, P v x.val y.val

def strong_stability [fintype V] (F : VSCC) (P : Prof V X) : Prop :=
  ∀ (a b : X) (e : a ≠ b), 0 ≤ margin P a b → (⟨a, e⟩ : {x : X // x ≠ b}) ∈ F V {x : X // x ≠ b} (minus_candidate P b) → a ∈ F V X P

lemma margin_eq_margin_minus_candidate [fintype V] {P : Prof V X} (b : X) {x y : X} (h : x ≠ b) (e : y ≠ b) :
  margin (minus_candidate P b) ⟨x, h⟩ ⟨y, e⟩ = margin P x y :=
begin
  obviously,
end

theorem split_cycle_strong_stability [fintype V] (P : Prof V X) : strong_stability split_cycle P :=
begin
  unfold strong_stability,
  intros a b e m w y,
  unfold split_cycle at *, unfold max_el_VSCC at *,
  simp at *,
  unfold split_cycle_VCCR, unfold split_cycle_CCR,
  simp at *,
  use _inst_1,
  --intro p,
  by_cases y ≠ b,
    {specialize w y, specialize w h,
    unfold split_cycle_VCCR at w, unfold split_cycle_CCR at w,
    simp at w,
    cases w with i2 w,
    intro m2,
    unfold margin_pos at m2,
    rw ←(margin_eq_margin_minus_candidate b h e) at m2,
    change margin_pos (minus_candidate P b) ⟨y, h⟩ ⟨a, e⟩ at m2,
    unfold margin_pos at w,
    rw margin_eq_margin i2 _inst_1 at w,
    specialize w m2,
    cases w with c w,
    cases w with y_mem w,
    cases w with a_mem w,
    use (c.map subtype.val),
    simp,
    use h, exact y_mem,
    use e, exact a_mem,
    rw ←margin_eq_margin_minus_candidate b h e,
    unfold cycle at *,
    cases w with n w,
    split,
    work_on_goal 1
      {by_contradiction, push_neg at h, exact n (list.map_eq_nil.mp h),},
    rw list.last_map subtype.val n,
    refine list.chain_map_of_chain subtype.val _ w,
    obviously,
    rw margin_eq_margin i2 _inst_1 at ᾰ,
    obviously,},
  push_neg at h,
  rw h,
  intro m2,
  rw margin_antisymmetric at m,
  exfalso,
  simp at m,
  have o : ∀ (n : ℤ), n ≤ 0 → ¬ 0 < n := by omega,
  exact (o (margin P b a) m) m2,
end


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.nat.lemmas
import Mathlib.Lean3Lib.init.meta.well_founded_tactics

universes u

namespace Mathlib

namespace nat

def bodd_div2 : ℕ → Bool × ℕ := sorry

def div2 (n : ℕ) : ℕ := prod.snd (bodd_div2 n)

def bodd (n : ℕ) : Bool := prod.fst (bodd_div2 n)

@[simp] theorem bodd_zero : bodd 0 = false := rfl

@[simp] theorem bodd_one : bodd 1 = tt := rfl

@[simp] theorem bodd_two : bodd (bit0 1) = false := rfl

@[simp] theorem bodd_succ (n : ℕ) : bodd (Nat.succ n) = bnot (bodd n) := sorry

@[simp] theorem bodd_add (m : ℕ) (n : ℕ) : bodd (m + n) = bxor (bodd m) (bodd n) := sorry

@[simp] theorem bodd_mul (m : ℕ) (n : ℕ) : bodd (m * n) = bodd m && bodd n := sorry

theorem mod_two_of_bodd (n : ℕ) : n % bit0 1 = cond (bodd n) 1 0 := sorry

@[simp] theorem div2_zero : div2 0 = 0 := rfl

@[simp] theorem div2_one : div2 1 = 0 := rfl

@[simp] theorem div2_two : div2 (bit0 1) = 1 := rfl

@[simp] theorem div2_succ (n : ℕ) :
    div2 (Nat.succ n) = cond (bodd n) (Nat.succ (div2 n)) (div2 n) :=
  sorry

theorem bodd_add_div2 (n : ℕ) : cond (bodd n) 1 0 + bit0 1 * div2 n = n := sorry

theorem div2_val (n : ℕ) : div2 n = n / bit0 1 := sorry

def bit (b : Bool) : ℕ → ℕ := cond b bit1 bit0

theorem bit0_val (n : ℕ) : bit0 n = bit0 1 * n :=
  Eq.trans
    (Eq.trans
      (eq.mpr (id (Eq._oldrec (Eq.refl (n + n = 0 + n + n)) (nat.zero_add n))) (Eq.refl (n + n)))
      rfl)
    (nat.mul_comm n (bit0 1))

theorem bit1_val (n : ℕ) : bit1 n = bit0 1 * n + 1 := congr_arg Nat.succ (bit0_val n)

theorem bit_val (b : Bool) (n : ℕ) : bit b n = bit0 1 * n + cond b 1 0 :=
  bool.cases_on b (bit0_val n) (bit1_val n)

theorem bit_decomp (n : ℕ) : bit (bodd n) (div2 n) = n :=
  Eq.trans (bit_val (bodd n) (div2 n))
    (Eq.trans (nat.add_comm (bit0 1 * div2 n) (cond (bodd n) 1 0)) (bodd_add_div2 n))

def bit_cases_on {C : ℕ → Sort u} (n : ℕ) (h : (b : Bool) → (n : ℕ) → C (bit b n)) : C n :=
  eq.mpr sorry (h (bodd n) (div2 n))

@[simp] theorem bit_zero : bit false 0 = 0 := rfl

def shiftl' (b : Bool) (m : ℕ) : ℕ → ℕ := sorry

def shiftl : ℕ → ℕ → ℕ := shiftl' false

@[simp] theorem shiftl_zero (m : ℕ) : shiftl m 0 = m := rfl

@[simp] theorem shiftl_succ (m : ℕ) (n : ℕ) : shiftl m (n + 1) = bit0 (shiftl m n) := rfl

def shiftr : ℕ → ℕ → ℕ := sorry

def test_bit (m : ℕ) (n : ℕ) : Bool := bodd (shiftr m n)

def binary_rec {C : ℕ → Sort u} (z : C 0) (f : (b : Bool) → (n : ℕ) → C n → C (bit b n)) (n : ℕ) :
    C n :=
  sorry

def size : ℕ → ℕ := binary_rec 0 fun (_x : Bool) (_x : ℕ) => Nat.succ

def bits : ℕ → List Bool := binary_rec [] fun (b : Bool) (_x : ℕ) (IH : List Bool) => b :: IH

def bitwise (f : Bool → Bool → Bool) : ℕ → ℕ → ℕ :=
  binary_rec (fun (n : ℕ) => cond (f false tt) n 0)
    fun (a : Bool) (m : ℕ) (Ia : ℕ → ℕ) =>
      binary_rec (cond (f tt false) (bit a m) 0) fun (b : Bool) (n _x : ℕ) => bit (f a b) (Ia n)

def lor : ℕ → ℕ → ℕ := bitwise bor

def land : ℕ → ℕ → ℕ := bitwise band

def ldiff : ℕ → ℕ → ℕ := bitwise fun (a b : Bool) => a && bnot b

def lxor : ℕ → ℕ → ℕ := bitwise bxor

@[simp] theorem binary_rec_zero {C : ℕ → Sort u} (z : C 0)
    (f : (b : Bool) → (n : ℕ) → C n → C (bit b n)) : binary_rec z f 0 = z :=
  sorry

/- bitwise ops -/

theorem bodd_bit (b : Bool) (n : ℕ) : bodd (bit b n) = b := sorry

theorem div2_bit (b : Bool) (n : ℕ) : div2 (bit b n) = n := sorry

theorem shiftl'_add (b : Bool) (m : ℕ) (n : ℕ) (k : ℕ) :
    shiftl' b m (n + k) = shiftl' b (shiftl' b m n) k :=
  sorry

theorem shiftl_add (m : ℕ) (n : ℕ) (k : ℕ) : shiftl m (n + k) = shiftl (shiftl m n) k :=
  shiftl'_add false

theorem shiftr_add (m : ℕ) (n : ℕ) (k : ℕ) : shiftr m (n + k) = shiftr (shiftr m n) k := sorry

theorem shiftl'_sub (b : Bool) (m : ℕ) {n : ℕ} {k : ℕ} :
    k ≤ n → shiftl' b m (n - k) = shiftr (shiftl' b m n) k :=
  sorry

theorem shiftl_sub (m : ℕ) {n : ℕ} {k : ℕ} : k ≤ n → shiftl m (n - k) = shiftr (shiftl m n) k :=
  shiftl'_sub false

@[simp] theorem test_bit_zero (b : Bool) (n : ℕ) : test_bit (bit b n) 0 = b := bodd_bit b n

theorem test_bit_succ (m : ℕ) (b : Bool) (n : ℕ) : test_bit (bit b n) (Nat.succ m) = test_bit n m :=
  sorry

theorem binary_rec_eq {C : ℕ → Sort u} {z : C 0} {f : (b : Bool) → (n : ℕ) → C n → C (bit b n)}
    (h : f false 0 z = z) (b : Bool) (n : ℕ) :
    binary_rec z f (bit b n) = f b n (binary_rec z f n) :=
  sorry

theorem bitwise_bit_aux {f : Bool → Bool → Bool} (h : f false false = false) :
    (binary_rec (cond (f tt false) (bit false 0) 0)
          fun (b : Bool) (n _x : ℕ) => bit (f false b) (cond (f false tt) n 0)) =
        fun (n : ℕ) => cond (f false tt) n 0 :=
  sorry

@[simp] theorem bitwise_zero_left (f : Bool → Bool → Bool) (n : ℕ) :
    bitwise f 0 n = cond (f false tt) n 0 :=
  sorry

@[simp] theorem bitwise_zero_right (f : Bool → Bool → Bool) (h : f false false = false) (m : ℕ) :
    bitwise f m 0 = cond (f tt false) m 0 :=
  sorry

@[simp] theorem bitwise_zero (f : Bool → Bool → Bool) : bitwise f 0 0 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (bitwise f 0 0 = 0)) (bitwise_zero_left f 0)))
    (bool.cases_on (f false tt) (Eq.refl (cond false 0 0)) (Eq.refl (cond tt 0 0)))

@[simp] theorem bitwise_bit {f : Bool → Bool → Bool} (h : f false false = false) (a : Bool) (m : ℕ)
    (b : Bool) (n : ℕ) : bitwise f (bit a m) (bit b n) = bit (f a b) (bitwise f m n) :=
  sorry

theorem bitwise_swap {f : Bool → Bool → Bool} (h : f false false = false) :
    bitwise (function.swap f) = function.swap (bitwise f) :=
  sorry

@[simp] theorem lor_bit (a : Bool) (m : ℕ) (b : Bool) (n : ℕ) :
    lor (bit a m) (bit b n) = bit (a || b) (lor m n) :=
  bitwise_bit rfl

@[simp] theorem land_bit (a : Bool) (m : ℕ) (b : Bool) (n : ℕ) :
    land (bit a m) (bit b n) = bit (a && b) (land m n) :=
  bitwise_bit rfl

@[simp] theorem ldiff_bit (a : Bool) (m : ℕ) (b : Bool) (n : ℕ) :
    ldiff (bit a m) (bit b n) = bit (a && bnot b) (ldiff m n) :=
  bitwise_bit rfl

@[simp] theorem lxor_bit (a : Bool) (m : ℕ) (b : Bool) (n : ℕ) :
    lxor (bit a m) (bit b n) = bit (bxor a b) (lxor m n) :=
  bitwise_bit rfl

@[simp] theorem test_bit_bitwise {f : Bool → Bool → Bool} (h : f false false = false) (m : ℕ)
    (n : ℕ) (k : ℕ) : test_bit (bitwise f m n) k = f (test_bit m k) (test_bit n k) :=
  sorry

@[simp] theorem test_bit_lor (m : ℕ) (n : ℕ) (k : ℕ) :
    test_bit (lor m n) k = test_bit m k || test_bit n k :=
  test_bit_bitwise rfl

@[simp] theorem test_bit_land (m : ℕ) (n : ℕ) (k : ℕ) :
    test_bit (land m n) k = test_bit m k && test_bit n k :=
  test_bit_bitwise rfl

@[simp] theorem test_bit_ldiff (m : ℕ) (n : ℕ) (k : ℕ) :
    test_bit (ldiff m n) k = test_bit m k && bnot (test_bit n k) :=
  test_bit_bitwise rfl

@[simp] theorem test_bit_lxor (m : ℕ) (n : ℕ) (k : ℕ) :
    test_bit (lxor m n) k = bxor (test_bit m k) (test_bit n k) :=
  test_bit_bitwise rfl

end Mathlib


import convex convex_body multiset brunn_minkowski microid set_pi
  microid_ops sequence pre_pruning

open_locale pointwise
open_locale topological_space
open_locale nat

-- needed to get decidable_eq for sets!
open classical
local attribute [instance] prop_decidable

variables {V : Type} [inner_product_space ℝ V] [finite_dimensional ℝ V]

lemma tendsto_polytope_of_tendsto_generator {k : ℕ}
{t : ℕ → microid_generator_space V k}
{tl : microid_generator_space V k}
(tt : filter.tendsto t filter.at_top (𝓝 tl)) :
filter.tendsto (λ n, convex_body_of_polytope (polytope_of_microid_generator (t n))) filter.at_top
  (𝓝 (convex_body_of_polytope (polytope_of_microid_generator tl))) :=
begin
  simp only [body_of_poly_of_gen_eq],
  exact filter.tendsto.comp (body_of_gen_continuous_at tl) tt,
end

lemma angle_self_zero {k : ℕ} (m : fin k.succ) (u : metric.sphere (0 : V) 1) :
angle m m u = (λ G : microid_generator_space V k, 0) :=
begin
  funext,
  simp only [angle, sub_self, norm_zero, div_zero],
end

lemma cuspiness_eq_angle {k : ℕ}
(u : metric.sphere (0 : V) 1) (t : prune_triple V k) :
cuspiness u t = angle (prune_secondary_index t) (prune_cusp_index t) u (prune_triple_generator t) :=
begin
  simp only [cuspiness, angle, prune_direction, prune_cusp,
  prune_secondary, prune_gen_fn, prune_triple_generator],
end

lemma fun_eq_lambda {α β : Type} (f : α → β) :
f = (λ a, f a) := rfl

lemma diam_norm_eq_one {k : ℕ}
{G : unbounded_microid_generator V k} (h : diam_generator' G > 0) :
diam_generator' (norm_generator' G) = 1 :=
begin
  cases diam_norm_generator G,
  {assumption},
  {linarith},
end

lemma zero_mem_norm_generator {k : ℕ}
(G : microid_generator_space V k) :
(norm_generator G).val 0 = 0 :=
begin
  simp only [body_of_microid_generator, norm_generator, norm_generator'],
  simp only [scale_translate_gen, scale_gen, translate_gen, add_right_neg, smul_zero],
end

/- lemma zero_mem_of_tendsto
(t : ℕ → convex_body V)
(tl : convex_body V)
(htt : filter.tendsto t filter.at_top (𝓝 tl))
(hmem : ∀ n : ℕ, (0 : V) ∈ (t n).val) :
(0 : V) ∈ tl.val :=
begin
  admit,
end -/

lemma pruning_lemma' {k : ℕ} {u : metric.sphere (0 : V) 1}
{t : ℕ → prune_triple V k}
(valid : ∀ n : ℕ, valid_prune_triple (t n) u)
-- (is_cusp : ∀ n : ℕ, prune_cusp_index (t n) ∈ generator_face (prune_triple_generator (t n)) u)
(tt : filter.tendsto ((cuspiness u) ∘ t) filter.at_top (𝓝 (0 : ℝ))) :
∃ (c : ℕ) (G : microid_generator_space V c),
c ≤ k ∧
(0 : V) ∈ (polytope_of_microid_generator G).val ∧
vector_span ℝ (polytope_of_microid_generator G).val ≠ ⊥ ∧
vector_span ℝ (polytope_of_microid_generator G).val ≤ vector_orth u.val ∧
in_combinatorial_closure u
((body_of_microid_generator ∘ prune_triple_generator ∘ t) '' set.univ)
(body_of_microid_generator G) :=
begin
  have is_cusp : ∀ n : ℕ, prune_cusp_index (t n) ∈ generator_face (prune_triple_generator (t n)) u,
  {
    intro n,
    simp only [generator_face, finset.mem_coe, finset.mem_filter],
    refine ⟨finset.mem_fin_range _, (valid n).1⟩,
  },
  let s :=
  λ n : ℕ, (prune_cusp_index (t n), prune_secondary_index (t n)),
  -- have hs : ∀ n, (s n).nonempty := λ n, generator_face_nonempty (prune_triple_generator (t n)) u,
  -- rcases ex_const_mem_subseq_of_setvalued_seq hs with ⟨b, ϕ, hmon, hb⟩,
  rcases ex_const_subseq_of_finite_range
    (λ n : ℕ, (prune_cusp_index (t n), prune_secondary_index (t n)))
      with ⟨⟨m, l⟩, ϕ, mon, index_const⟩,
  simp only [prod.mk.inj_iff] at index_const,
  replace index_const := and.intro (λ n, (index_const n).1.symm) (λ n, (index_const n).2.symm),
  have hm : ∀ n : ℕ, m ∈ generator_face (prune_triple_generator ((t ∘ ϕ) n)) u,
  {
    intro n,
    rw [index_const.1],
    apply is_cusp,
  },
  -- change ∀ (n : ℕ), b ∈ (s ∘ ϕ) n at hb,
  rcases pre_pruning_lemma hm
    with ⟨c, φ, ϕ₂, tl, clek, ⟨hmon, htt, hg, ha⟩, exU⟩,
  refine ⟨c, tl, clek, _, _, _, _⟩,
  {
    have := filter.tendsto.comp
      --(continuous_at_apply 0 _)
      continuous_at_subtype_coe
      htt,
    replace := filter.tendsto.comp
      (continuous_at_apply 0 _)
      this,
    replace : filter.tendsto 0 filter.at_top (𝓝 (tl.val 0)),
    {
      convert this,
      funext,
      simp only [prunenorm_generator, function.comp_app, ←subtype.val_eq_coe],
      rw[zero_mem_norm_generator _],
      refl,
    },
    simp only [polytope_of_microid_generator],
    apply subset_convex_hull ℝ,
    refine ⟨0, _⟩,
    exact tendsto_nhds_unique this tendsto_const_nhds,
  },
  {
    suffices h : diam_generator' tl.val = 1,
    {
      intro vsz,
      have nz : set.subsingleton (set.range tl.val),
      {
        intros x hx y hy,
        simp only [polytope_of_microid_generator] at vsz,
        replace hx := subset_convex_hull ℝ _ hx,
        replace hy := subset_convex_hull ℝ _ hy,
        have := vsub_mem_vector_span ℝ hx hy,
        rw [vsz] at this,
        replace this := (submodule.mem_bot ℝ).mp this,
        exact eq_of_sub_eq_zero this,
      },
      have := metric.diam_subsingleton nz,
      simp only [diam_generator', set.image_univ] at h,
      linarith,
    },
    let t' := λ n : ℕ, (prunenorm_generator φ (prune_triple_generator (t (ϕ (ϕ₂ n))))).val,
    suffices h₂ : ∀ n : ℕ,
    diam_generator' (t' n) = 1,
    {
      have htt' : filter.tendsto t' filter.at_top (𝓝 tl.val),
      {
        exact filter.tendsto.comp continuous_subtype_val.continuous_at htt,
      },
      refine lim_norm_gen htt' h₂,
    },
    have mφ : m ∈ finset.image φ finset.univ,
    {
      refine ha m _,
      simp only [anglett, angle_self_zero],
      convert tendsto_const_nhds,
      tauto,
    },
    have lφ : l ∈ finset.image φ finset.univ,
    {
      refine ha l _,
      replace tt := tendsto_subseq_of_tendsto _ mon tt,
      rw [fun_eq_lambda ((cuspiness u ∘ t) ∘ ϕ)] at tt,
      simp only [function.comp_app, cuspiness_eq_angle] at tt,
      simp only [anglett],
      convert tt,
      funext n,
      simp only [function.comp_app],
      rw [index_const.1 n, index_const.2 n],
    },
    rcases finset.mem_image.mp mφ with ⟨pm, -, rfl⟩,
    rcases finset.mem_image.mp lφ with ⟨pl, -, rfl⟩,
    intro n,
    simp only [t', prunenorm_generator],
    refine diam_norm_eq_one _,
    simp only [diam_generator', chop_generator, chop_generator'],
    have hd : dist ((prune_triple_generator (t (ϕ (ϕ₂ n)))).val (φ pm))
                   ((prune_triple_generator (t (ϕ (ϕ₂ n)))).val (φ pl)) > 0,
    {
      rw [gt_iff_lt, dist_pos],
      rw [index_const.1 (ϕ₂ n), index_const.2 (ϕ₂ n)],
      simp only [valid_prune_triple] at valid,
      exact (valid _).2,
    },
    refine lt_of_lt_of_le hd _,
    simp only [set.image_univ],
    exact metric.dist_le_diam_of_mem (pi_range_bounded _) ⟨pm, rfl⟩ ⟨pl, rfl⟩,
  },
  {
    simp only [vector_span, polytope_of_microid_generator],
    simp only [set_vsub_eq_sub],
    rw [←convex_hull_sub],
    rw [submodule.span_le],
    refine convex_hull_subset_vector_space _ _ _,
    intros v hv,
    change v ∈ vector_orth u.val,
    rw [mem_vector_orth],
    rcases hv with ⟨a, b, ⟨pa, rfl⟩, ⟨pb, rfl⟩, rfl⟩,
    simp only [generator_face, finset.mem_coe, finset.mem_filter] at hg,
    apply le_antisymm,
    all_goals {
      simp only [inner_sub_left, sub_nonpos, sub_nonneg],
      refine (hg _).2 _,
    },
  },
  {
    have bodytt := filter.tendsto.comp (body_of_gen_continuous_at tl) htt,
    have polytt := tendsto_polytope_of_tendsto_generator htt,
    rw [set.image_comp],
    rcases exU with ⟨U, hU, hlfe⟩,
    let S := polytope_of_microid_generator '' (prune_triple_generator ∘ t '' set.univ),
    have : in_combinatorial_closure u (convex_body_of_polytope '' S) _,
    {
      refine comb_cl_of_lfe hU polytt _,
      simp only [S],
      rw [←set.image_comp],
      intro n,
      refine ⟨polytope_of_microid_generator (prune_triple_generator (t (ϕ (ϕ₂ n)))), _, _⟩,
      {
        refine ⟨ϕ (ϕ₂ n), set.mem_univ _, rfl⟩,
      },
      {
        apply lfe_symm,
        exact hlfe n,
      },
    },
    rw [←set.image_comp] at this,
    convert this,
    all_goals {
      funext,
      simp only [function.comp_app, body_of_poly_of_gen_eq],
    },
  },
end

def fin_retraction {k₁ k₂ : ℕ} (h : k₁ ≤ k₂) (l : fin k₂.succ) : fin k₁.succ :=
⟨min l.val k₁, lt_of_le_of_lt (min_le_right _ _) (nat.lt_succ_self _)⟩

lemma fin_retraction_comp_incl {k₁ k₂ : ℕ} (h : k₁ ≤ k₂) :
fin_retraction h ∘ fin.cast_le (nat.succ_le_succ h) = id :=
begin
  funext,
  simp only [fin_retraction, fin.val_eq_coe, fin.coe_cast_le,
    function.comp_app, id.def],
  apply fin.coe_injective,
  simp only [fin.val_eq_coe, fin.coe_cast_le, fin.coe_mk, min_eq_left_iff],
  exact nat.le_of_lt_succ x.property,
end

def convert_generator {k₁ k₂ : ℕ} (h : k₁ ≤ k₂) (G : microid_generator_space V k₁) :
microid_generator_space V k₂ :=
begin
  refine ⟨G.val ∘ (fin_retraction h), _⟩,
  have Gmem := G.property,
  simp only [mem_closed_ball_zero_iff] at Gmem ⊢,
  apply (pi_norm_le_iff zero_le_one).mpr,
  simp only [function.comp_app],
  intro i,
  exact (pi_norm_le_iff zero_le_one).mp Gmem (fin_retraction h i),
end

lemma polytope_convert_eq {k₁ k₂ : ℕ} (h : k₁ ≤ k₂) (G : microid_generator_space V k₁) :
polytope_of_microid_generator (convert_generator h G) =
polytope_of_microid_generator G :=
begin
  simp only [polytope_of_microid_generator, convert_generator],
  simp only [subtype.mk_eq_mk],
  refine congr_arg _ _,
  apply le_antisymm,
  {
    exact set.range_comp_subset_range _ _,
  },
  {
    conv {
      to_lhs,
      rw [←function.comp.right_id G.val, ←fin_retraction_comp_incl h,
        ←function.comp.assoc],
    },
    exact set.range_comp_subset_range _ _,
  },
end

lemma body_convert_eq {k₁ k₂ : ℕ} (h : k₁ ≤ k₂) (G : microid_generator_space V k₁) :
body_of_microid_generator (convert_generator h G) =
body_of_microid_generator G :=
begin
  simp only [←body_of_poly_of_gen_eq],
  rw [polytope_convert_eq h],
end

lemma pruning_lemma {k : ℕ} {u : metric.sphere (0 : V) 1}
{t : ℕ → prune_triple V k}
(valid : ∀ n : ℕ, valid_prune_triple (t n) u)
(tt : filter.tendsto ((cuspiness u) ∘ t) filter.at_top (𝓝 (0 : ℝ))) :
∃ (G : microid_generator_space V k),
(0 : V) ∈ (polytope_of_microid_generator G).val ∧
vector_span ℝ (polytope_of_microid_generator G).val ≠ ⊥ ∧
vector_span ℝ (polytope_of_microid_generator G).val ≤ vector_orth u.val ∧
in_combinatorial_closure u
((body_of_microid_generator ∘ prune_triple_generator ∘ t) '' set.univ)
(body_of_microid_generator G) :=
begin
  rcases pruning_lemma' valid tt with
    ⟨c, G', hle, hG'⟩,
  let G := convert_generator hle G',
  refine ⟨convert_generator hle G', _⟩,
  simp only [polytope_convert_eq hle, body_convert_eq hle],
  exact hG',
end


import data.set
import data.set.basic
import tactic.suggest
import tactic.basic
import tactic.nth_rewrite.default

import loose
import cong

namespace UA
  universes u_lang u_str u_t

  section

    /- A theory `τ`, over σ, is a set of `axioms` which must hold universally. -/

    class theory extends signature.{u_lang} :=
    (axioms_ : set (word.{u_lang} ℕ × word.{u_lang} ℕ))

    abbreviation equation [σ : signature.{u_lang}] (T : Type u_t) := word T × word T
    local notation `sentance` := equation ℕ

    /- Formally an `equation` is just a pair of words. A `sentance` is an equation in
    -- which the variables are intended to be arbitrary (i.e. placeholders).       -/

    section
      parameter [τ : theory.{u_lang}]
      include τ

      -- all instances of a sentance within a given set
      def st_instances (T : Type u_t) (st : sentance) : set (equation T) :=
      ⋃ subst : ℕ → T, {(subst† st.fst, subst† st.snd)}

      -- all instances of our axioms within a given set
      def ax_instances (T : Type u_t) : set (equation T) :=
      (⋃ ax ∈ τ.axioms_, st_instances T ax)

      -- the interpretation of an equation in a given structure
      def eval_eqn {α : Type u_str} [act : action_on α] (e : equation α) : α × α :=
      (eval e.fst, eval e.snd)

      -- those sentances which are 'modelled' by a given structure
      def true_sentances (α : Type u_str) [act : action_on α] : set sentance :=
      λ st, ∀ inst ∈ st_instances α st, (eval_eqn inst).fst = (eval_eqn inst).snd

      -- predicate that a structure satisfies the axioms of τ
      @[class] def satisfies_τ (α : Type u_str) [act : action_on α] := τ.axioms_ ⊆ true_sentances α

      -- more user-friendly version of this statement
      lemma satisfies_iff (α : Type u_str) [act : action_on α] : satisfies_τ α ↔
      ∀ inst ∈ ax_instances α, (eval_eqn inst).fst = (eval_eqn inst).snd :=
      begin
        split, all_goals {intro h_main}, {

          apply set.Union₂_subset,

          intros ax is_ax,
          specialize @h_main ax is_ax,       -- introduce spesific axiom and specialize

          rw [st_instances, set.Union_subset_iff],

          intros subst eqn equal,            -- `subst` witnesses the valididity of `eqn`
          apply h_main eqn,                  -- so the hypothesis says that `eqn` holds
          rw [st_instances, set.mem_Union],
          exact exists.intro subst equal,    -- after we provide the witness `subst`

        },
        {

          intros ax is_ax inst is_inst,      -- have 2 variables with 2 properties

          apply h_main inst,
          rw [ax_instances, set.mem_Union],
          apply exists.intro ax,
          rw set.mem_Union,                  -- specialize to variables

          exact exists.intro is_ax is_inst,  -- use properties

        },
      end
    end

    section
      parameter [τ : theory.{u_lang}]
      include τ

      /- Given any structure, we can enfore the axioms in the 'free-est' possible way.
      -- The construction of 'free objects' (e.g. groups) is a special case of this -/

      def enforce_axioms : Π X : Structure.{u_lang u_str}, congruence X :=
      λ X, UA.congruence.gen_by_set (eval_eqn '' (ax_instances X))

      -- proof a bit long, might try and silm down later
      theorem axioms_enforced {X : Structure.{u_lang u_str}} : satisfies_τ (enforce_axioms X).quotient :=
      begin

        let C := enforce_axioms X, -- the congruence on X
        let X' := C.quotient,      -- the quotient object

        apply (satisfies_iff X').2,
        intros eqn eqn_is_axiom,

        cases eqn with lhs rhs,
        simp_rw [ax_instances, set.mem_Union] at eqn_is_axiom,
        cases eqn_is_axiom with ax eqn_is_axiom,
        cases eqn_is_axiom with is_axiom eqn_is_axiom,
        simp_rw [st_instances, set.mem_Union] at eqn_is_axiom,
        cases eqn_is_axiom with substitution eqn_is_axiom,
        simp_rw [set.mem_singleton_iff, prod.ext_iff] at eqn_is_axiom,
        cases eqn_is_axiom with left_is_axiom right_is_axiom,
        simp_rw [left_is_axiom, right_is_axiom, eval_eqn],

        let lift_of_subst := section_of_quot C.r ∘ substitution,
        have lift_compatable : C.π ∘ lift_of_subst = substitution, {
          rw ← function.comp.assoc,
          simp_rw [congruence.π, section_of_quot_section],
          exact function.comp.left_id _,
        },

        rw ← lift_compatable,
        nth_rewrite_lhs 0 translation_functorial,
        nth_rewrite_rhs 0 translation_functorial,

        simp_rw ← hom_iff.1 C.proj_is_hom (lift_of_subst† ax.fst),
        simp_rw ← hom_iff.1 C.proj_is_hom (lift_of_subst† ax.snd),

        apply quot.sound,
        apply congruence.gentd_contains_gens,
        rw set.mem_image,
        use ((translate (section_of_quot C.r) lhs),
        (translate (section_of_quot C.r) rhs)),
        split,

        -- witness is valid
        rw ax_instances,
        rw set.mem_Union,
        use ax,
        rw set.mem_Union,
        use is_axiom,
        rw st_instances,
        rw set.mem_Union,
        use lift_of_subst,
        rw set.mem_singleton_iff,
        apply prod.ext; {
          simp,
          nth_rewrite_rhs 0 translation_functorial,
          apply congr_arg,
          assumption,
        },

        -- witness is correct
        nth_rewrite_rhs 0 translation_functorial,
        nth_rewrite_rhs 1 translation_functorial,
        rw eval_eqn,
        apply prod.ext; {
          simp,
          apply congr_arg,
          apply congr_arg,
          assumption,
        },

      end

    end

    parameter [τ : theory.{u_lang}]
    include τ

    /- A τ-`Object` is just a structure satisfying the axioms of τ. -/

    structure Object :=
    (medium      : Type u_str)
    (action      : action_on.{u_lang u_str} medium)
    (satf_axioms : satisfies_τ medium)

  end
end UA


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebraic_geometry.presheafed_space
import topology.category.Top.limits
import topology.sheaves.limits
import category_theory.limits.concrete_category

/-!
# `PresheafedSpace C` has colimits.

If `C` has limits, then the category `PresheafedSpace C` has colimits,
and the forgetful functor to `Top` preserves these colimits.

When restricted to a diagram where the underlying continuous maps are open embeddings,
this says that we can glue presheaved spaces.

Given a diagram `F : J ⥤ PresheafedSpace C`,
we first build the colimit of the underlying topological spaces,
as `colimit (F ⋙ PresheafedSpace.forget C)`. Call that colimit space `X`.

Our strategy is to push each of the presheaves `F.obj j`
forward along the continuous map `colimit.ι (F ⋙ PresheafedSpace.forget C) j` to `X`.
Since pushforward is functorial, we obtain a diagram `J ⥤ (presheaf C X)ᵒᵖ`
of presheaves on a single space `X`.
(Note that the arrows now point the other direction,
because this is the way `PresheafedSpace C` is set up.)

The limit of this diagram then constitutes the colimit presheaf.
-/

noncomputable theory

universes v u

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

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

namespace algebraic_geometry

namespace PresheafedSpace

@[simp]
lemma map_id_c_app (F : J ⥤ PresheafedSpace C) (j) (U) :
  (F.map (𝟙 j)).c.app (op U) =
    (pushforward.id (F.obj j).presheaf).inv.app (op U) ≫
      (pushforward_eq (by { simp, refl }) (F.obj j).presheaf).hom.app (op U) :=
begin
  cases U,
  dsimp,
  simp [PresheafedSpace.congr_app (F.map_id j)],
  refl,
end

@[simp]

/--
Given a diagram of presheafed spaces,
we can push all the presheaves forward to the colimit `X` of the underlying topological spaces,
obtaining a diagram in `(presheaf C X)ᵒᵖ`.
-/
@[simps]
def pushforward_diagram_to_colimit (F : J ⥤ PresheafedSpace C) :
  J ⥤ (presheaf C (colimit (F ⋙ PresheafedSpace.forget C)))ᵒᵖ :=
{ obj := λ j, op ((colimit.ι (F ⋙ PresheafedSpace.forget C) j) _* (F.obj j).presheaf),
  map := λ j j' f,
  (pushforward_map (colimit.ι (F ⋙ PresheafedSpace.forget C) j') (F.map f).c ≫
    (pushforward.comp (F.obj j).presheaf ((F ⋙ PresheafedSpace.forget C).map f)
      (colimit.ι (F ⋙ PresheafedSpace.forget C) j')).inv ≫
    (pushforward_eq (colimit.w (F ⋙ PresheafedSpace.forget C) f) (F.obj j).presheaf).hom).op,
  map_id' := λ j,
  begin
    apply (op_equiv _ _).injective,
    ext U,
    op_induction U,
    cases U,
    dsimp, simp, dsimp, simp,
  end,
  map_comp' := λ j₁ j₂ j₃ f g,
  begin
    apply (op_equiv _ _).injective,
    ext U,
    dsimp,
    simp only [map_comp_c_app, id.def, eq_to_hom_op, pushforward_map_app, eq_to_hom_map, assoc,
      id_comp, pushforward.comp_inv_app, pushforward_eq_hom_app],
    dsimp,
    simp only [eq_to_hom_trans, id_comp],
    congr' 1,
    -- The key fact is `(F.map f).c.congr`,
    -- which allows us in rewrite in the argument of `(F.map f).c.app`.
    rw (F.map f).c.congr,
    -- Now we pick up the pieces. First, we say what we want to replace that open set by:
    swap 3,
    refine op ((opens.map (colimit.ι (F ⋙ PresheafedSpace.forget C) j₂)).obj (unop U)),
    -- Now we show the open sets are equal.
    swap 2,
    { apply unop_injective,
      rw ←opens.map_comp_obj,
      congr,
      exact colimit.w (F ⋙ PresheafedSpace.forget C) g, },
    -- Finally, the original goal is now easy:
    swap 2,
    { simp, refl, },
  end, }

variables [has_limits C]

/--
Auxilliary definition for `PresheafedSpace.has_colimits`.
-/
@[simps]
def colimit (F : J ⥤ PresheafedSpace C) : PresheafedSpace C :=
{ carrier := colimit (F ⋙ PresheafedSpace.forget C),
  presheaf := limit (pushforward_diagram_to_colimit F).left_op, }

/--
Auxilliary definition for `PresheafedSpace.has_colimits`.
-/
@[simps]
def colimit_cocone (F : J ⥤ PresheafedSpace C) : cocone F :=
{ X := colimit F,
  ι :=
  { app := λ j,
    { base := colimit.ι (F ⋙ PresheafedSpace.forget C) j,
      c := limit.π _ (op j), },
    naturality' := λ j j' f,
    begin
      fapply PresheafedSpace.ext,
      { ext x,
        exact colimit.w_apply (F ⋙ PresheafedSpace.forget C) f x, },
      { ext U,
        op_induction U,
        cases U,
        dsimp,
        simp only [PresheafedSpace.id_c_app, eq_to_hom_op, eq_to_hom_map, assoc,
          pushforward.comp_inv_app],
        rw ← congr_arg nat_trans.app (limit.w (pushforward_diagram_to_colimit F).left_op f.op),
        dsimp,
        simp only [eq_to_hom_op, eq_to_hom_map, assoc, id_comp, pushforward.comp_inv_app],
        congr,
        dsimp,
        simp only [id_comp],
        rw ←is_iso.inv_comp_eq,
        simp, refl, }
    end, }, }

namespace colimit_cocone_is_colimit

/--
Auxilliary definition for `PresheafedSpace.colimit_cocone_is_colimit`.
-/
def desc_c_app (F : J ⥤ PresheafedSpace C) (s : cocone F) (U : (opens ↥(s.X.carrier))ᵒᵖ) :
  s.X.presheaf.obj U ⟶
    (colimit.desc (F ⋙ PresheafedSpace.forget C)
         ((PresheafedSpace.forget C).map_cocone s) _*
       limit (pushforward_diagram_to_colimit F).left_op).obj
      U :=
begin
  refine
    limit.lift _ { X := s.X.presheaf.obj U, π := { app := λ j, _, naturality' := λ j j' f, _, }} ≫
      (limit_obj_iso_limit_comp_evaluation _ _).inv,
  -- We still need to construct the `app` and `naturality'` fields omitted above.
  { refine (s.ι.app (unop j)).c.app U ≫ (F.obj (unop j)).presheaf.map (eq_to_hom _),
    dsimp,
    rw ←opens.map_comp_obj,
    simp, },
  { rw (PresheafedSpace.congr_app (s.w f.unop).symm U),
    dsimp,
    have w := functor.congr_obj (congr_arg opens.map
      (colimit.ι_desc ((PresheafedSpace.forget C).map_cocone s) (unop j))) (unop U),
    simp only [opens.map_comp_obj_unop] at w,
    replace w := congr_arg op w,
    have w' := nat_trans.congr (F.map f.unop).c w,
    rw w',
    dsimp, simp, dsimp, simp, refl, },
end

lemma desc_c_naturality (F : J ⥤ PresheafedSpace C) (s : cocone F)
  {U V : (opens ↥(s.X.carrier))ᵒᵖ} (i : U ⟶ V) :
  s.X.presheaf.map i ≫ desc_c_app F s V =
  desc_c_app F s U ≫ (colimit.desc (F ⋙ forget C)
    ((forget C).map_cocone s) _* (colimit_cocone F).X.presheaf).map i :=
begin
  dsimp [desc_c_app],
  ext,
  simp only [limit.lift_π, nat_trans.naturality, limit.lift_π_assoc, eq_to_hom_map, assoc,
    pushforward_obj_map, nat_trans.naturality_assoc, op_map,
    limit_obj_iso_limit_comp_evaluation_inv_π_app_assoc,
    limit_obj_iso_limit_comp_evaluation_inv_π_app],
  dsimp,
  have w := functor.congr_hom (congr_arg opens.map
    (colimit.ι_desc ((PresheafedSpace.forget C).map_cocone s) (unop j))) (i.unop),
  simp only [opens.map_comp_map] at w,
  replace w := congr_arg quiver.hom.op w,
  rw w,
  dsimp, simp,
end

end colimit_cocone_is_colimit

open colimit_cocone_is_colimit

/--
Auxilliary definition for `PresheafedSpace.has_colimits`.
-/
def colimit_cocone_is_colimit (F : J ⥤ PresheafedSpace C) : is_colimit (colimit_cocone F) :=
{ desc := λ s,
  { base := colimit.desc (F ⋙ PresheafedSpace.forget C) ((PresheafedSpace.forget C).map_cocone s),
    c :=
    { app := λ U, desc_c_app F s U,
      naturality' := λ U V i, desc_c_naturality F s i }, },
  fac' := -- tidy can do this but it takes too long
  begin
    intros s j,
    dsimp,
    fapply PresheafedSpace.ext,
    { simp, },
    { ext,
      dsimp [desc_c_app],
      simp only [eq_to_hom_op, limit.lift_π_assoc, eq_to_hom_map, assoc, pushforward.comp_inv_app,
                 limit_obj_iso_limit_comp_evaluation_inv_π_app_assoc],
      dsimp,
      simp },
  end,
  uniq' := λ s m w,
  begin
    -- We need to use the identity on the continuous maps twice, so we prepare that first:
    have t : m.base = colimit.desc (F ⋙ PresheafedSpace.forget C)
                        ((PresheafedSpace.forget C).map_cocone s),
    { ext,
      dsimp,
      simp only [colimit.ι_desc_apply, map_cocone_ι_app],
      rw ← w j,
      simp, },
    fapply PresheafedSpace.ext, -- could `ext` please not reorder goals?
    { exact t, },
    { ext U j, dsimp [desc_c_app],
      simp only [limit.lift_π, eq_to_hom_op, eq_to_hom_map, assoc,
        limit_obj_iso_limit_comp_evaluation_inv_π_app],
      rw PresheafedSpace.congr_app (w (unop j)).symm U,
      dsimp,
      have w := congr_arg op (functor.congr_obj (congr_arg opens.map t) (unop U)),
      rw nat_trans.congr (limit.π (pushforward_diagram_to_colimit F).left_op j) w,
      simp, dsimp, simp, }
  end, }

/--
When `C` has limits, the category of presheaved spaces with values in `C` itself has colimits.
-/
instance : has_colimits (PresheafedSpace C) :=
{ has_colimits_of_shape := λ J 𝒥, by exactI
  { has_colimit := λ F, has_colimit.mk
    { cocone     := colimit_cocone F,
      is_colimit := colimit_cocone_is_colimit F } } }

/--
The underlying topological space of a colimit of presheaved spaces is
the colimit of the underlying topological spaces.
-/
instance forget_preserves_colimits : preserves_colimits (PresheafedSpace.forget C) :=
{ preserves_colimits_of_shape := λ J 𝒥, by exactI
  { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone
    (colimit_cocone_is_colimit F)
    begin
      apply is_colimit.of_iso_colimit (colimit.is_colimit _),
      fapply cocones.ext,
      { refl, },
      { intro j, dsimp, simp, }
    end } }

end PresheafedSpace

end algebraic_geometry