/-
Copyright (c) 2017 Mario Carneiro. 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.default
import Mathlib.data.multiset.erase_dup
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Preparations for defining operations on `finset`.

The operations here ignore multiplicities,
and preparatory for defining the corresponding operations on `finset`.
-/

namespace multiset

/-! ### finset insert -/

/-- `ndinsert a s` is the lift of the list `insert` operation. This operation
  does not respect multiplicities, unlike `cons`, but it is suitable as
  an insert operation on `finset`. -/
def ndinsert {α : Type u_1} [DecidableEq α] (a : α) (s : multiset α) : multiset α :=
  quot.lift_on s (fun (l : List α) => ↑(list.insert a l)) sorry

@[simp] theorem coe_ndinsert {α : Type u_1} [DecidableEq α] (a : α) (l : List α) :
    ndinsert a ↑l = ↑(insert a l) :=
  rfl

@[simp] theorem ndinsert_zero {α : Type u_1} [DecidableEq α] (a : α) : ndinsert a 0 = a ::ₘ 0 := rfl

@[simp] theorem ndinsert_of_mem {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α} :
    a ∈ s → ndinsert a s = s :=
  quot.induction_on s
    fun (l : List α) (h : a ∈ Quot.mk setoid.r l) => congr_arg coe (list.insert_of_mem h)

@[simp] theorem ndinsert_of_not_mem {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α} :
    ¬a ∈ s → ndinsert a s = a ::ₘ s :=
  quot.induction_on s
    fun (l : List α) (h : ¬a ∈ Quot.mk setoid.r l) => congr_arg coe (list.insert_of_not_mem h)

@[simp] theorem mem_ndinsert {α : Type u_1} [DecidableEq α] {a : α} {b : α} {s : multiset α} :
    a ∈ ndinsert b s ↔ a = b ∨ a ∈ s :=
  quot.induction_on s fun (l : List α) => list.mem_insert_iff

@[simp] theorem le_ndinsert_self {α : Type u_1} [DecidableEq α] (a : α) (s : multiset α) :
    s ≤ ndinsert a s :=
  quot.induction_on s
    fun (l : List α) => list.sublist.subperm (list.sublist_of_suffix (list.suffix_insert a l))

@[simp] theorem mem_ndinsert_self {α : Type u_1} [DecidableEq α] (a : α) (s : multiset α) :
    a ∈ ndinsert a s :=
  iff.mpr mem_ndinsert (Or.inl rfl)

theorem mem_ndinsert_of_mem {α : Type u_1} [DecidableEq α] {a : α} {b : α} {s : multiset α}
    (h : a ∈ s) : a ∈ ndinsert b s :=
  iff.mpr mem_ndinsert (Or.inr h)

@[simp] theorem length_ndinsert_of_mem {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α}
    (h : a ∈ s) : coe_fn card (ndinsert a s) = coe_fn card s :=
  sorry

@[simp] theorem length_ndinsert_of_not_mem {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α}
    (h : ¬a ∈ s) : coe_fn card (ndinsert a s) = coe_fn card s + 1 :=
  sorry

theorem erase_dup_cons {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α} :
    erase_dup (a ::ₘ s) = ndinsert a (erase_dup s) :=
  sorry

theorem nodup_ndinsert {α : Type u_1} [DecidableEq α] (a : α) {s : multiset α} :
    nodup s → nodup (ndinsert a s) :=
  quot.induction_on s fun (l : List α) => list.nodup_insert

theorem ndinsert_le {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α} {t : multiset α} :
    ndinsert a s ≤ t ↔ s ≤ t ∧ a ∈ t :=
  sorry

theorem attach_ndinsert {α : Type u_1} [DecidableEq α] (a : α) (s : multiset α) :
    attach (ndinsert a s) =
        ndinsert { val := a, property := mem_ndinsert_self a s }
          (map
            (fun (p : Subtype fun (x : α) => x ∈ s) =>
              { val := subtype.val p, property := mem_ndinsert_of_mem (subtype.property p) })
            (attach s)) :=
  sorry

@[simp] theorem disjoint_ndinsert_left {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α}
    {t : multiset α} : disjoint (ndinsert a s) t ↔ ¬a ∈ t ∧ disjoint s t :=
  sorry

@[simp] theorem disjoint_ndinsert_right {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α}
    {t : multiset α} : disjoint s (ndinsert a t) ↔ ¬a ∈ s ∧ disjoint s t :=
  sorry

/-! ### finset union -/

/-- `ndunion s t` is the lift of the list `union` operation. This operation
  does not respect multiplicities, unlike `s ∪ t`, but it is suitable as
  a union operation on `finset`. (`s ∪ t` would also work as a union operation
  on finset, but this is more efficient.) -/
def ndunion {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : multiset α :=
  quotient.lift_on₂ s t (fun (l₁ l₂ : List α) => ↑(list.union l₁ l₂)) sorry

@[simp] theorem coe_ndunion {α : Type u_1} [DecidableEq α] (l₁ : List α) (l₂ : List α) :
    ndunion ↑l₁ ↑l₂ = ↑(l₁ ∪ l₂) :=
  rfl

@[simp] theorem zero_ndunion {α : Type u_1} [DecidableEq α] (s : multiset α) : ndunion 0 s = s :=
  quot.induction_on s fun (l : List α) => rfl

@[simp] theorem cons_ndunion {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α)
    (a : α) : ndunion (a ::ₘ s) t = ndinsert a (ndunion s t) :=
  quotient.induction_on₂ s t fun (l₁ l₂ : List α) => rfl

@[simp] theorem mem_ndunion {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α}
    {a : α} : a ∈ ndunion s t ↔ a ∈ s ∨ a ∈ t :=
  quotient.induction_on₂ s t fun (l₁ l₂ : List α) => list.mem_union

theorem le_ndunion_right {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) :
    t ≤ ndunion s t :=
  quotient.induction_on₂ s t
    fun (l₁ l₂ : List α) =>
      list.sublist.subperm (list.sublist_of_suffix (list.suffix_union_right l₁ l₂))

theorem subset_ndunion_right {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) :
    t ⊆ ndunion s t :=
  subset_of_le (le_ndunion_right s t)

theorem ndunion_le_add {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) :
    ndunion s t ≤ s + t :=
  quotient.induction_on₂ s t
    fun (l₁ l₂ : List α) => list.sublist.subperm (list.union_sublist_append l₁ l₂)

theorem ndunion_le {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α}
    {u : multiset α} : ndunion s t ≤ u ↔ s ⊆ u ∧ t ≤ u :=
  sorry

theorem subset_ndunion_left {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) :
    s ⊆ ndunion s t :=
  fun (a : α) (h : a ∈ s) => iff.mpr mem_ndunion (Or.inl h)

theorem le_ndunion_left {α : Type u_1} [DecidableEq α] {s : multiset α} (t : multiset α)
    (d : nodup s) : s ≤ ndunion s t :=
  iff.mpr (le_iff_subset d) (subset_ndunion_left s t)

theorem ndunion_le_union {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) :
    ndunion s t ≤ s ∪ t :=
  iff.mpr ndunion_le { left := subset_of_le (le_union_left s t), right := le_union_right s t }

theorem nodup_ndunion {α : Type u_1} [DecidableEq α] (s : multiset α) {t : multiset α} :
    nodup t → nodup (ndunion s t) :=
  quotient.induction_on₂ s t fun (l₁ l₂ : List α) => list.nodup_union l₁

@[simp] theorem ndunion_eq_union {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α}
    (d : nodup s) : ndunion s t = s ∪ t :=
  le_antisymm (ndunion_le_union s t) (union_le (le_ndunion_left t d) (le_ndunion_right s t))

theorem erase_dup_add {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) :
    erase_dup (s + t) = ndunion s (erase_dup t) :=
  quotient.induction_on₂ s t fun (l₁ l₂ : List α) => congr_arg coe (list.erase_dup_append l₁ l₂)

/-! ### finset inter -/

/-- `ndinter s t` is the lift of the list `∩` operation. This operation
  does not respect multiplicities, unlike `s ∩ t`, but it is suitable as
  an intersection operation on `finset`. (`s ∩ t` would also work as a union operation
  on finset, but this is more efficient.) -/
def ndinter {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : multiset α :=
  filter (fun (_x : α) => _x ∈ t) s

@[simp] theorem coe_ndinter {α : Type u_1} [DecidableEq α] (l₁ : List α) (l₂ : List α) :
    ndinter ↑l₁ ↑l₂ = ↑(l₁ ∩ l₂) :=
  rfl

@[simp] theorem zero_ndinter {α : Type u_1} [DecidableEq α] (s : multiset α) : ndinter 0 s = 0 :=
  rfl

@[simp] theorem cons_ndinter_of_mem {α : Type u_1} [DecidableEq α] {a : α} (s : multiset α)
    {t : multiset α} (h : a ∈ t) : ndinter (a ::ₘ s) t = a ::ₘ ndinter s t :=
  sorry

@[simp] theorem ndinter_cons_of_not_mem {α : Type u_1} [DecidableEq α] {a : α} (s : multiset α)
    {t : multiset α} (h : ¬a ∈ t) : ndinter (a ::ₘ s) t = ndinter s t :=
  sorry

@[simp] theorem mem_ndinter {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α}
    {a : α} : a ∈ ndinter s t ↔ a ∈ s ∧ a ∈ t :=
  mem_filter

@[simp] theorem nodup_ndinter {α : Type u_1} [DecidableEq α] {s : multiset α} (t : multiset α) :
    nodup s → nodup (ndinter s t) :=
  nodup_filter fun (_x : α) => _x ∈ t

theorem le_ndinter {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α}
    {u : multiset α} : s ≤ ndinter t u ↔ s ≤ t ∧ s ⊆ u :=
  sorry

theorem ndinter_le_left {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) :
    ndinter s t ≤ s :=
  and.left (iff.mp le_ndinter (le_refl (ndinter s t)))

theorem ndinter_subset_left {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) :
    ndinter s t ⊆ s :=
  subset_of_le (ndinter_le_left s t)

theorem ndinter_subset_right {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) :
    ndinter s t ⊆ t :=
  and.right (iff.mp le_ndinter (le_refl (ndinter s t)))

theorem ndinter_le_right {α : Type u_1} [DecidableEq α] {s : multiset α} (t : multiset α)
    (d : nodup s) : ndinter s t ≤ t :=
  iff.mpr (le_iff_subset (nodup_ndinter t d)) (ndinter_subset_right s t)

theorem inter_le_ndinter {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) :
    s ∩ t ≤ ndinter s t :=
  iff.mpr le_ndinter { left := inter_le_left s t, right := subset_of_le (inter_le_right s t) }

@[simp] theorem ndinter_eq_inter {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α}
    (d : nodup s) : ndinter s t = s ∩ t :=
  le_antisymm (le_inter (ndinter_le_left s t) (ndinter_le_right t d)) (inter_le_ndinter s t)

theorem ndinter_eq_zero_iff_disjoint {α : Type u_1} [DecidableEq α] {s : multiset α}
    {t : multiset α} : ndinter s t = 0 ↔ disjoint s t :=
  sorry

end Mathlib


import .binders
import .misc_list

import data.finset

set_option pp.parens true

open formula

/-
[margaris]
pg. 48

If $P$ is a formula, $v$ is a variable, and $t$ is a term, then $P(t/v)$ is the result of replacing each free occurrence of $v$ in $P$ by an occurrence of $t$.
-/

/--
  Helper function for replace_free.
-/
def replace_free_aux (v t : variable_) : finset variable_ → formula → formula
| _ (true_) := true_
| binders (pred_ name args) :=
    pred_
    name
    (args.map (fun (x : variable_), if x = v ∧ x ∉ binders then t else x))
| binders (eq_ x y) :=
    eq_
    (if x = v ∧ x ∉ binders then t else x)
    (if y = v ∧ y ∉ binders then t else y)
| binders (not_ P) := not_ (replace_free_aux binders P)
| binders (imp_ P Q) :=
    imp_
    (replace_free_aux binders P)
    (replace_free_aux binders Q)
| binders (forall_ x P) := forall_ x (replace_free_aux (binders ∪ {x}) P)

/--
  replace_free v t P :=

  P(t/v)

  v → t in P for each free occurrence of v in P

  The result of replacing each free occurrence of v in P by an occurrence of t.
-/
def replace_free (v t : variable_) (P : formula) : formula :=
  replace_free_aux v t ∅ P

/--
  fast_replace_free v t P :=

  P(t/v)

  v → t in P for each free occurrence of v in P

  The result of replacing each free occurrence of v in P by an occurrence of t.

  This is a more efficient version of replace_free.
-/
def fast_replace_free (v t : variable_) : formula → formula
| (true_) := true_
| (pred_ name args) :=
    pred_
    name
    (args.map (fun (x : variable_), if x = v then t else x))
| (eq_ x y) :=
    eq_
    (if x = v then t else x)
    (if y = v then t else y)
| (not_ P) := not_ (fast_replace_free P)
| (imp_ P Q) := imp_ (fast_replace_free P) (fast_replace_free Q)
| (forall_ x P) :=
    if v = x
    then forall_ x P -- v is not free in P
    else forall_ x (fast_replace_free P)

-- replace_free = fast_replace_free

lemma replace_free_aux_mem_binders
  (P : formula)
  (v t : variable_)
  (binders : finset variable_)
  (h1 : v ∈ binders) :
  replace_free_aux v t binders P = P :=
begin
  induction P generalizing binders,
  case formula.true_ : binders h1
  {
    refl,
  },
  case formula.pred_ : name args binders h1
  {
    unfold replace_free_aux,
    simp only [eq_self_iff_true, list.map_eq_self_iff, ite_eq_right_iff, and_imp, true_and],
    intros x a1 a2 a3,
    subst a2,
    contradiction,
  },
  case formula.eq_ : x y binders h1
  {
    unfold replace_free_aux,
    congr,
    {
      simp only [ite_eq_right_iff, and_imp],
      intros a1 a2,
      subst a1,
      contradiction,
    },
    {
      simp only [ite_eq_right_iff, and_imp],
      intros a1 a2,
      subst a1,
      contradiction,
    }
  },
  case formula.not_ : P P_ih binders h1
  {
    solve_by_elim,
  },
  case formula.imp_ : P Q P_ih Q_ih binders h1
  {
    unfold replace_free_aux,
    congr,
    {
      exact P_ih binders h1,
    },
    {
      exact Q_ih binders h1,
    }
  },
  case formula.forall_ : x P P_ih binders h1
  {
    unfold replace_free_aux,
    simp only [eq_self_iff_true, true_and],
    apply P_ih,
    simp only [finset.mem_union, finset.mem_singleton],
    tauto,
  },
end

lemma replace_free_aux_eq_fast_replace_free
  (P : formula)
  (v t : variable_)
  (binders : finset variable_)
  (h1 : v ∉ binders) :
  replace_free_aux v t binders P = fast_replace_free v t P :=
begin
  induction P generalizing binders,
  case formula.true_ : binders h1
  {
    refl,
  },
  case formula.pred_ : name args binders h1
  {
    unfold replace_free_aux,
    unfold fast_replace_free,
    congr,
    funext,
    by_cases c1 : x = v,
    {
      subst c1,
      simp only [eq_self_iff_true, true_and, ite_not, if_true, ite_eq_right_iff],
      intros a1,
      contradiction,
    },
    {
      simp only [if_neg c1],
      simp only [ite_eq_right_iff, and_imp],
      intros a1,
      contradiction,
    }
  },
  case formula.eq_ : x y binders h1
  {
    unfold replace_free_aux,
    unfold fast_replace_free,
    congr,
    {
      simp only [eq_iff_iff, and_iff_left_iff_imp],
      intros a1,
      subst a1,
      exact h1,
    },
    {
      simp only [eq_iff_iff, and_iff_left_iff_imp],
      intros a1,
      subst a1,
      exact h1,
    }
  },
  case formula.not_ : P P_ih binders h1
  {
    unfold replace_free_aux,
    unfold fast_replace_free,
    simp only,
    exact P_ih binders h1,
  },
  case formula.imp_ : P Q P_ih Q_ih binders h1
  {
    unfold replace_free_aux,
    unfold fast_replace_free,
    simp only,
    split,
    {
      exact P_ih binders h1,
    },
    {
      exact Q_ih binders h1,
    }
  },
  case formula.forall_ : x P P_ih binders h1
  {
    unfold replace_free_aux,
    unfold fast_replace_free,
    split_ifs,
    {
      simp only [eq_self_iff_true, true_and],
      apply replace_free_aux_mem_binders,
      simp only [finset.mem_union, finset.mem_singleton],
      right,
      exact h,
    },
    {
      simp only [eq_self_iff_true, true_and],
      apply P_ih,
      simp only [finset.mem_union, finset.mem_singleton],
      push_neg,
      split,
      {
        exact h1,
      },
      {
        exact h,
      }
    }
  },
end

theorem replace_free_eq_fast_replace_free
  (P : formula)
  (v t : variable_) :
  replace_free v t P = fast_replace_free v t P :=
begin
  unfold replace_free,
  apply replace_free_aux_eq_fast_replace_free,
  simp only [finset.not_mem_empty, not_false_iff],
end

--

theorem fast_replace_free_self
  (P : formula)
  (v : variable_) :
  fast_replace_free v v P = P :=
begin
  induction P,
  case formula.true_
  {
    refl,
  },
  case formula.pred_ : name args
  {
    unfold fast_replace_free,
    simp only [eq_self_iff_true, list.map_eq_self_iff, ite_eq_right_iff, true_and],
    tauto,
  },
  case formula.eq_ : x y
  {
    unfold fast_replace_free,
    simp only [ite_eq_right_iff],
    tauto,
  },
  case formula.not_ : P P_ih
  {
    solve_by_elim,
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold fast_replace_free,
    simp only,
    tauto,
  },
  case formula.forall_ : x P P_ih
  {
    unfold fast_replace_free,
    simp only [ite_eq_left_iff, eq_self_iff_true, true_and],
    tauto,
  },
end

theorem not_free_in_fast_replace_free_self
  (P : formula)
  (v t : variable_)
  (h1 : ¬ is_free_in v P) :
  fast_replace_free v t P = P :=
begin
  induction P,
  case formula.true_
  {
    refl,
  },
  case formula.pred_ : name args
  {
    unfold is_free_in at h1,
    simp only [list.mem_to_finset] at h1,

    unfold fast_replace_free,
    congr,
    simp only [list.map_eq_self_iff, ite_eq_right_iff],
    intros x a1 a2,
    subst a2,
    contradiction,
  },
  case formula.eq_ : x y
  {
    unfold is_free_in at h1,
    push_neg at h1,
    cases h1,

    unfold fast_replace_free,
    congr,
    {
      simp only [ite_eq_right_iff],
      tauto,
    },
    {
      simp only [ite_eq_right_iff],
      tauto,
    }
  },
  case formula.not_ : P P_ih
  {
    solve_by_elim,
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold is_free_in at h1,
    push_neg at h1,
    cases h1,

    unfold fast_replace_free,
    congr,
    {
      exact P_ih h1_left,
    },
    {
      exact Q_ih h1_right,
    }
  },
  case formula.forall_ : x P P_ih
  {
    unfold is_free_in at h1,
    push_neg at h1,

    unfold fast_replace_free,
    simp only [ite_eq_left_iff, eq_self_iff_true, true_and],
    tauto,
  },
end

theorem fast_replace_free_inverse
  (P : formula)
  (v t : variable_)
  (h1 : ¬ occurs_in t P) :
  fast_replace_free t v (fast_replace_free v t P) = P :=
begin
  induction P,
  case formula.true_
  {
    refl,
  },
  case formula.pred_ : name args
  {
    unfold occurs_in at h1,
    simp only [list.mem_to_finset] at h1,

    unfold fast_replace_free,
    congr,
    simp only [list.map_map, list.map_eq_self_iff, function.comp_app, ite_eq_left_iff],
    intros x a1,
    by_cases c1 : x = v,
    {
      subst c1,
      simp only [eq_self_iff_true, not_true, is_empty.forall_iff, if_true],
    },
    {
      simp only [if_neg c1],
      simp only [ite_eq_right_iff],
      intros a2,
      specialize a2 c1,
      subst a2,
      contradiction,
    },
  },
  case formula.eq_ : x y
  {
    unfold occurs_in at h1,
    push_neg at h1,
    cases h1,

    unfold fast_replace_free,
    congr,
    {
      simp only [ite_eq_left_iff],
      by_cases c1 : x = v,
      {
        subst c1,
        simp only [eq_self_iff_true, not_true, is_empty.forall_iff, if_true],
      },
      {
        simp only [if_neg c1],
        simp only [ite_eq_right_iff],
        tauto,
      },
    },
    {
      simp only [ite_eq_left_iff],
      by_cases c1 : y = v,
      {
        subst c1,
        simp only [eq_self_iff_true, not_true, is_empty.forall_iff, if_true],
      },
      {
        simp only [if_neg c1],
        simp only [ite_eq_right_iff],
        tauto,
      },
    }
  },
  case formula.not_ : P P_ih
  {
    solve_by_elim,
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold occurs_in at h1,
    push_neg at h1,
    cases h1,

    unfold fast_replace_free,
    congr,
    {
      exact P_ih h1_left,
    },
    {
      exact Q_ih h1_right,
    }
  },
  case formula.forall_ : x P P_ih
  {
    unfold occurs_in at h1,
    push_neg at h1,
    cases h1,

    unfold fast_replace_free,
    split_ifs,
    {
      unfold fast_replace_free,
      simp [if_neg h1_left],
      apply not_free_in_fast_replace_free_self,
      contrapose! h1_right,
      exact is_free_in_imp_occurs_in P t h1_right,
    },
    {
      unfold fast_replace_free,
      simp only [if_neg h1_left],
      tauto,
    }
  },
end

theorem not_is_free_in_fast_replace_free
  (P : formula)
  (v t : variable_)
  (h1 : ¬ v = t) :
  ¬ is_free_in v (fast_replace_free v t P) :=
begin
  induction P,
  case formula.true_
  {
    intros a1,
    assumption,
  },
  case formula.pred_ : name args
  {
    unfold fast_replace_free,
    unfold is_free_in,
    simp only [list.mem_to_finset, list.mem_map, not_exists, not_and],
    intros x a1,
    split_ifs,
    {
      tauto,
    },
    {
      exact h,
    }
  },
  case formula.eq_ : x y
  {
    unfold fast_replace_free,
    unfold is_free_in,
    push_neg,
    split,
    {
      split_ifs,
      {
        exact h1,
      },
      {
        tauto,
      }
    },
    {
      split_ifs,
      {
        exact h1,
      },
      {
        tauto,
      }
    }
  },
  case formula.not_ : P P_ih
  {
    assumption,
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold fast_replace_free,
    unfold is_free_in,
    push_neg,
    split,
    {
      exact P_ih,
    },
    {
      exact Q_ih,
    }
  },
  case formula.forall_ : x P P_ih
  {
    unfold fast_replace_free,
    split_ifs,
    {
      unfold is_free_in,
      tauto,
    },
    {
      unfold is_free_in,
      tauto,
    }
  },
end

#lint


import tactic
import order.filter.partial
import convergence_space.basic
import data.set.pointwise
import order.filter.pointwise
import extra

noncomputable theory
open set filter classical option function prod
open convergence_space
open_locale classical filter pointwise

variables {M G α β γ : Type*}

/-!
### Convergence semigroups, monoids, groups
-/

/-- Basic hypothesis to talk about a convergence monoid or a convergence
  semigroup. A convergence monoid over `M`, for example, is obtained by
  requiring both the instances monoid `M` and has_continuous_mul `M`. -/
class has_continuous_mul (α : Type*)
  [convergence_space α] [has_mul α] : Prop :=
(continuous_mul : continuous2 ((*) : α → α → α))

open has_continuous_mul

/-- Class `has_continuous_smul M α` says that the scalar multiplication
  `(•) : M → α → α` is continuous in both arguments. -/
class has_continuous_smul (M α : Type*)
  [has_smul M α] [convergence_space M] [convergence_space α] : Prop :=
(continuous_smul : continuous2 ((•) : M → α → α))

open has_continuous_smul

/-- A convergence group is a group in which the multiplication and inversion
  operations are continuous. -/
class convergence_group (G : Type*)
  [convergence_space G] [group G] extends has_continuous_mul G : Prop :=
(continuous_inv : continuous (has_inv.inv : G → G))

open convergence_group

/-- Class `has_continuous_partial_smul M α` says that the partial scalar multiplication
  is continuous on `smul_dom`. -/
class has_continuous_partial_smul (M α : Type*) [has_partial_smul M α]
  [convergence_space M] [convergence_space α] : Prop :=
(continuous_partial_smul : ∀ {a : M} {x : α} {g : filter M} {f : filter α},
  converges g a → converges f x → smul_defined a x → converges (partial_smul g f) (a • x))

export has_continuous_partial_smul

/-!
### Enveloping action
-/

namespace envelope

variables [group G] [partial_mul_action G α]
variables [convergence_space G] [convergence_group G]
variables [convergence_space α]

lemma embed.continuous : continuous (embed G : α → space G α) :=
continuous.comp continuous_quot_mk (continuous.prod.mk 1)

instance : has_continuous_smul G (G × α) :=
{ continuous_smul :=
  begin
    rw continuous2_continuous_iff,
    unfold continuous,
    rintro ⟨a₁, ⟨a₂, x⟩⟩ : G × (G × α),
    rintro k : filter (G × (G × α)),
    rintro hk : converges k (a₁, (a₂, x)),
    let act : G × (G × α) → G × α := uncurry has_smul.smul,
    let mul : G × G → G := uncurry has_mul.mul,
    let rlassoc := (equiv.prod_assoc G G α).symm.to_fun,
    have heq : act = prod.map mul id ∘ rlassoc, by { funext; tidy },
    let g₁ : filter G := map fst k,
    let hg₁ : converges g₁ a₁ := hk.1,
    let g₂ : filter G := map (fst ∘ snd) k,
    let hg₂ : converges g₂ a₂ := hk.2.1,
    let f : filter α := map (snd ∘ snd) k,
    let hf : converges f x := hk.2.2,
    let g : filter (G × G) := g₁ ×ᶠ g₂,
    let a : G × G := (a₁, a₂),
    have hg : converges g a := prod.converges hg₁ hg₂,
    have : converges (map mul g) (mul a), from continuous2_continuous_iff.mp continuous_mul hg,
    have hconv : converges (map mul g ×ᶠ f) (mul a, x), from prod.converges this hf,
    have hle : k ≤ g₁ ×ᶠ (g₂ ×ᶠ f), from calc
      k ≤ map fst k ×ᶠ map snd k : filter.le_prod_map_fst_snd
      ... = g₁ ×ᶠ map snd k : by tauto
      ... ≤ g₁ ×ᶠ (map fst (map snd k) ×ᶠ map snd (map snd k)) :
        prod_mono (le_refl g₁) filter.le_prod_map_fst_snd
      ... = g₁ ×ᶠ (map (fst ∘ snd) k ×ᶠ map (snd ∘ snd) k) :
        by simp [filter.map_map]
      ... = g₁ ×ᶠ (g₂ ×ᶠ f) : by tauto,
    have heq' : map act (g₁ ×ᶠ (g₂ ×ᶠ f)) = map mul g ×ᶠ f, from calc
      map act (g₁ ×ᶠ (g₂ ×ᶠ f)) = map (prod.map mul id ∘ rlassoc) (g₁ ×ᶠ (g₂ ×ᶠ f)) :
        by rw heq
      ... = map (prod.map mul id) (map rlassoc (g₁ ×ᶠ (g₂ ×ᶠ f))) :
        by simp [← filter.map_map]
      ... = map (prod.map mul id) (map (equiv.prod_assoc G G α).symm (g₁ ×ᶠ (g₂ ×ᶠ f))) :
        by tauto
      ... = map (prod.map mul id) ((g₁ ×ᶠ g₂) ×ᶠ f) :
        by simp [← prod_assoc, filter.map_map]
      ... = map mul g ×ᶠ f :
        by simp [← filter.prod_map_map_eq'],
    have hle' : map act k ≤ map mul g ×ᶠ f, from eq.subst heq' (map_mono hle),
    exact le_converges hle' hconv,
  end }

instance
[convergence_space G] [convergence_group G]
[convergence_space α] [partial_mul_action G α] [has_continuous_partial_smul G α] :
has_continuous_smul G (space G α) :=
{ continuous_smul :=
  begin
    let act : G × (G × α) → (G × α) := uncurry (•),
    let qact : G × space G α → space G α := uncurry (•),
    let idquot : G × (G × α) → G × space G α :=
      prod.map id (quot.mk (envelope G α)),
    let quot_mk : G × α → space G α := quot.mk (envelope G α),
    have heq : qact ∘ idquot = quot_mk ∘ act, by { funext, tidy },
    have hqmap : quotient_map idquot,
      from quotient_map.prod_map quotient_map.id quotient_map_quot_mk,
    have hcontr : continuous (quot_mk ∘ act),
      from continuous.comp continuous_quot_mk (continuous2_continuous_iff.mp has_continuous_smul.continuous_smul),
    have hcont : continuous qact, begin
      rw [quotient_map.continuous_iff hqmap, heq],
      assumption,
    end,
    exact continuous2_continuous_iff.mpr hcont,
  end }

end envelope

/-!
### Adherence restrictive
-/

/-- A continuous action of a monoid `G` on `α` is adherence restrictive if for all convergent
  filters `g` on `G` and all filters `f` on `α` with `adh f = ∅`, `adh (g • f) = ∅`. -/
def adh_restrictive (G : Type*) (α : Type*) [group G] [convergence_space G]
  [convergence_group G] [convergence_space α] [mul_action G α] [has_continuous_smul G α] : Prop :=
∀ {g : filter G} {f : filter α} {a : G}, g.ne_bot → converges g a
  → adh f = ∅ → adh (g • f) = ∅

/-- This is a weaker version of `adh_restrictive` where instead of considering the adherence in `α`,
  it considers the adherence in the enveloping space. -/
def weakly_adh_restrictive (G : Type*) (α : Type*) [group G] [convergence_space G] [convergence_group G]
  [convergence_space α] [partial_mul_action G α] [has_continuous_partial_smul G α] : Prop :=
∀ {g : filter G} {f : filter α} {a : G}, g.ne_bot → converges g a → ((g ×ᶠ f) ⊓ 𝓟 (smul_dom G α)).ne_bot
  → adh (map (envelope.embed G) f) = ∅ → adh (partial_smul g f) = ∅

lemma adh_restrictive_result {G α : Type*} [group G] [convergence_space G] [convergence_group G]
  [convergence_space α] [mul_action G α] [has_continuous_smul G α] :
  adh_restrictive G α :=
begin
  intros g f a hgnb hgconv,
  haveI : g.ne_bot := hgnb,
  rw ← not_imp_not,
  intro hadh,
  obtain ⟨x, hx⟩ := ne_empty_iff_exists_elem.mp hadh,
  change adheres (g • f) x at hx,
  obtain ⟨h', hnb', hle', hconv'⟩ := hx,
  haveI : h'.ne_bot := hnb',
  let k' := ultrafilter.of h',
  have hle'' : ↑k' ≤ g • f, from (le_trans (ultrafilter.of_le h') hle'),
  set k : filter α := g⁻¹ • ↑k' with hdef,
  haveI : k.ne_bot := filter.ne_bot.smul (filter.ne_bot_inv_iff.mpr hgnb) k'.ne_bot,
  have hconv : converges k (a⁻¹ • x),
  begin
    have hconv_inv_g : converges g⁻¹ a⁻¹, from continuous_inv hgconv,
    have hconv_k' : converges ↑k' x,
      from le_converges (ultrafilter.of_le h') hconv',
    exact continuous_smul hconv_inv_g hconv_k',
  end,
  have hmem : a⁻¹ • x ∈ adh f,
  begin
    have hconv' : converges (k ⊓ f) (a⁻¹ • x),
      from le_converges inf_le_left hconv,
    haveI hnbI : (k ⊓ f).ne_bot := filter.inv_smul_inf_ne_bot hle'',
    have hadh'' : adheres f (a⁻¹ • x) := ⟨k ⊓ f, hnbI, inf_le_right, hconv'⟩,
    assumption,
  end,
  exact set.nonempty.ne_empty (set.nonempty_def.mpr ⟨a⁻¹ • x, hmem⟩)
end

/- This does not work. It results in a deterministic timeout.
lemma weakly_adh_restrictive_result {G α : Type*} [group G] [convergence_space G] [convergence_group G]
  [convergence_space α] [partial_mul_action G α]
  [has_continuous_partial_smul G α] : weakly_adh_restrictive G α :=
begin
  intros g f a hgnb hgconv hnb,
  haveI : g.ne_bot := hgnb,
  rw ← not_imp_not,
  intro hadh,
  obtain ⟨x, hx⟩ := ne_empty_iff_exists_elem.mp hadh,
  change adheres (partial_smul g f) x at hx,
  rw adheres.exists_ultrafilter (partial_smul g f) x at hx,
  obtain ⟨h, hle, hconv⟩ := hx,
  have hconv' : converges (g⁻¹ • map (envelope.embed G) ↑h) (a⁻¹ • envelope.embed G x) :=
    continuous_smul (continuous_inv hgconv) (envelope.embed.continuous hconv),
  have hmem : a⁻¹ • envelope.embed G x ∈ adh (map (envelope.embed G) f) :=
  begin
    change adheres (map (envelope.embed G) f) (a⁻¹ • envelope.embed G x),
    change ∃ (f' : filter (envelope.space G α)) [f'.ne_bot], f' ≤ map (envelope.embed G) f ∧ converges f' (a⁻¹ • envelope.embed G x),
    let f' := g⁻¹ • filter.map (envelope.embed G) ↑h ⊓ map (envelope.embed G) f, use f', split,
    { haveI : (filter.map (envelope.embed G) (h : filter α)).ne_bot := infer_instance,
      have : filter.map (envelope.embed G) ↑h ≤ g • map (envelope.embed G) f := sorry,
      exact inv_smul_inf_ne_bot this },
    split,
    { exact inf_le_right },
    { exact le_converges inf_le_left hconv' },
  end,
  rw ne_empty_iff_exists_elem,
  exact ⟨a⁻¹ • envelope.embed G x, hmem⟩
end
-/


example (P Q R : Prop) : (P → (Q → R)) → ((P → Q) → (P → R)) :=
begin
intros f h p,
apply (f p),
apply h,
exact p,
end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import number_theory.pell data.set data.pfun

universe u

open nat function

namespace int

lemma eq_nat_abs_iff_mul (x n) : nat_abs x = n ↔ (x - n) * (x + n) = 0 :=
begin
  refine iff.trans _ mul_eq_zero.symm,
  refine iff.trans _ (or_congr sub_eq_zero add_eq_zero_iff_eq_neg).symm,
  exact ⟨λe, by rw ← e; apply nat_abs_eq,
    λo, by cases o; subst x; simp [nat_abs_of_nat]⟩
end

end int

/-- An alternate definition of `fin n` defined as an inductive type
  instead of a subtype of `nat`. This is useful for its induction
  principle and different definitional equalities. -/
inductive fin2 : ℕ → Type
| fz {n} : fin2 (succ n)
| fs {n} : fin2 n → fin2 (succ n)

namespace fin2

@[elab_as_eliminator]
protected def cases' {n} {C : fin2 (succ n) → Sort u} (H1 : C fz) (H2 : Π n, C (fs n)) :
  Π (i : fin2 (succ n)), C i
| fz     := H1
| (fs n) := H2 n

def elim0 {C : fin2 0 → Sort u} : Π (i : fin2 0), C i.

/-- convert a `fin2` into a `nat` -/
def to_nat : Π {n}, fin2 n → ℕ
| ._ (@fz n)   := 0
| ._ (@fs n i) := succ (to_nat i)

/-- convert a `nat` into a `fin2` if it is in range -/
def opt_of_nat : Π {n} (k : ℕ), option (fin2 n)
| 0 _ := none
| (succ n) 0 := some fz
| (succ n) (succ k) := fs <$> @opt_of_nat n k

/-- `i + k : fin2 (n + k)` when `i : fin2 n` and `k : ℕ` -/
def add {n} (i : fin2 n) : Π k, fin2 (n + k)
| 0        := i
| (succ k) := fs (add k)

/-- `left k` is the embedding `fin2 n → fin2 (k + n)` -/
def left (k) : Π {n}, fin2 n → fin2 (k + n)
| ._ (@fz n)   := fz
| ._ (@fs n i) := fs (left i)

/-- `insert_perm a` is a permutation of `fin2 n` with the following properties:
  * `insert_perm a i = i+1` if `i < a`
  * `insert_perm a a = 0`
  * `insert_perm a i = i` if `i > a` -/
def insert_perm : Π {n}, fin2 n → fin2 n → fin2 n
| ._ (@fz n)          (@fz ._)   := fz
| ._ (@fz n)          (@fs ._ j) := fs j
| ._ (@fs (succ n) i) (@fz ._)   := fs fz
| ._ (@fs (succ n) i) (@fs ._ j) := match insert_perm i j with fz := fz | fs k := fs (fs k) end

/-- `remap_left f k : fin2 (m + k) → fin2 (n + k)` applies the function
  `f : fin2 m → fin2 n` to inputs less than `m`, and leaves the right part
  on the right (that is, `remap_left f k (m + i) = n + i`). -/
def remap_left {m n} (f : fin2 m → fin2 n) : Π k, fin2 (m + k) → fin2 (n + k)
| 0        i          := f i
| (succ k) (@fz ._)   := fz
| (succ k) (@fs ._ i) := fs (remap_left _ i)

/-- This is a simple type class inference prover for proof obligations
  of the form `m < n` where `m n : ℕ`. -/
class is_lt (m n : ℕ) := (h : m < n)
instance is_lt.zero (n) : is_lt 0 (succ n) := ⟨succ_pos _⟩
instance is_lt.succ (m n) [l : is_lt m n] : is_lt (succ m) (succ n) := ⟨succ_lt_succ l.h⟩

/-- Use type class inference to infer the boundedness proof, so that we
  can directly convert a `nat` into a `fin2 n`. This supports
  notation like `&1 : fin 3`. -/
def of_nat' : Π {n} m [is_lt m n], fin2 n
| 0        m        ⟨h⟩ := absurd h (not_lt_zero _)
| (succ n) 0        ⟨h⟩ := fz
| (succ n) (succ m) ⟨h⟩ := fs (@of_nat' n m ⟨lt_of_succ_lt_succ h⟩)

local prefix `&`:max := of_nat'

end fin2

open fin2

/-- Alternate definition of `vector` based on `fin2`. -/
def vector3 (α : Type u) (n : ℕ) : Type u := fin2 n → α

namespace vector3

/-- The empty vector -/
@[pattern] def nil {α} : vector3 α 0.

/-- The vector cons operation -/
@[pattern] def cons {α} {n} (a : α) (v : vector3 α n) : vector3 α (succ n) :=
λi, by {refine i.cases' _ _, exact a, exact v}

notation a :: b := cons a b
notation `[` l:(foldr `, ` (h t, cons h t) nil `]`) := l

@[simp] theorem cons_fz {α} {n} (a : α) (v : vector3 α n) : (a :: v) fz = a := rfl
@[simp] theorem cons_fs {α} {n} (a : α) (v : vector3 α n) (i) : (a :: v) (fs i) = v i := rfl

/-- Get the `i`th element of a vector -/
@[reducible] def nth {α} {n} (i : fin2 n) (v : vector3 α n) : α := v i

/-- Construct a vector from a function on `fin2`. -/
@[reducible] def of_fn {α} {n} (f : fin2 n → α) : vector3 α n := f

/-- Get the head of a nonempty vector. -/
def head {α} {n} (v : vector3 α (succ n)) : α := v fz

/-- Get the tail of a nonempty vector. -/
def tail {α} {n} (v : vector3 α (succ n)) : vector3 α n := λi, v (fs i)

theorem eq_nil {α} (v : vector3 α 0) : v = [] :=
funext $ λi, match i with end

theorem cons_head_tail {α} {n} (v : vector3 α (succ n)) : head v :: tail v = v :=
funext $ λi, fin2.cases' rfl (λ_, rfl) i

def nil_elim {α} {C : vector3 α 0 → Sort u} (H : C []) (v : vector3 α 0) : C v :=
by rw eq_nil v; apply H

def cons_elim {α n} {C : vector3 α (succ n) → Sort u} (H : Π (a : α) (t : vector3 α n), C (a :: t))
  (v : vector3 α (succ n)) : C v :=
by rw ← (cons_head_tail v); apply H

@[simp] theorem cons_elim_cons {α n C H a t} : @cons_elim α n C H (a :: t) = H a t := rfl

@[elab_as_eliminator]
protected def rec_on {α} {C : Π {n}, vector3 α n → Sort u} {n} (v : vector3 α n)
  (H0 : C [])
  (Hs : Π {n} (a) (w : vector3 α n), C w → C (a :: w)) : C v :=
nat.rec_on n
  (λv, v.nil_elim H0)
  (λn IH v, v.cons_elim (λa t, Hs _ _ (IH _))) v

@[simp] theorem rec_on_nil {α C H0 Hs} : @vector3.rec_on α @C 0 [] H0 @Hs = H0 :=
rfl

@[simp] theorem rec_on_cons {α C H0 Hs n a v} :
  @vector3.rec_on α @C (succ n) (a :: v) H0 @Hs = Hs a v (@vector3.rec_on α @C n v H0 @Hs) :=
rfl

/-- Append two vectors -/
def append {α} {m} (v : vector3 α m) {n} (w : vector3 α n) : vector3 α (n+m) :=
nat.rec_on m (λ_, w) (λm IH v, v.cons_elim $ λa t, @fin2.cases' (n+m) (λ_, α) a (IH t)) v

infix ` +-+ `:65 := append

@[simp] theorem append_nil {α} {n} (w : vector3 α n) : [] +-+ w = w := rfl

@[simp] theorem append_cons {α} (a : α) {m} (v : vector3 α m) {n} (w : vector3 α n) :
  (a::v) +-+ w = a :: (v +-+ w) := rfl

@[simp] theorem append_left {α} : ∀ {m} (i : fin2 m) (v : vector3 α m) {n} (w : vector3 α n),
  (v +-+ w) (left n i) = v i
| ._ (@fz m)   v n w := v.cons_elim (λa t, by simp [*, left])
| ._ (@fs m i) v n w := v.cons_elim (λa t, by simp [*, left])

@[simp] theorem append_add {α} : ∀ {m} (v : vector3 α m) {n} (w : vector3 α n) (i : fin2 n),
  (v +-+ w) (add i m) = w i
| 0        v n w i := rfl
| (succ m) v n w i := v.cons_elim (λa t, by simp [*, add])

/-- Insert `a` into `v` at index `i`. -/
def insert {α} (a : α) {n} (v : vector3 α n) (i : fin2 (succ n)) : vector3 α (succ n) :=
λj, (a :: v) (insert_perm i j)

@[simp] theorem insert_fz {α} (a : α) {n} (v : vector3 α n) : insert a v fz = a :: v :=
by refine funext (λj, j.cases' _ _); intros; refl

@[simp] theorem insert_fs {α} (a : α) {n} (b : α) (v : vector3 α n) (i : fin2 (succ n)) :
  insert a (b :: v) (fs i) = b :: insert a v i :=
funext $ λj, by {
  refine j.cases' _ (λj, _); simp [insert, insert_perm],
  refine fin2.cases' _ _ (insert_perm i j); simp [insert_perm] }

theorem append_insert {α} (a : α) {k} (t : vector3 α k) {n} (v : vector3 α n) (i : fin2 (succ n)) (e : succ n + k = succ (n + k)) :
  insert a (t +-+ v) (eq.rec_on e (i.add k)) = eq.rec_on e (t +-+ insert a v i) :=
begin
  refine vector3.rec_on t (λe, _) (λk b t IH e, _) e, refl,
  have e' := succ_add n k,
  change insert a (b :: (t +-+ v)) (eq.rec_on (congr_arg succ e') (fs (add i k)))
    = eq.rec_on (congr_arg succ e') (b :: (t +-+ insert a v i)),
  rw ← (eq.drec_on e' rfl : fs (eq.rec_on e' (i.add k) : fin2 (succ (n + k))) = eq.rec_on (congr_arg succ e') (fs (i.add k))),
  simp, rw IH, exact eq.drec_on e' rfl
end

end vector3

open vector3

/-- "Curried" exists, i.e. ∃ x1 ... xn, f [x1, ..., xn] -/
def vector_ex {α} : Π k, (vector3 α k → Prop) → Prop
| 0        f := f []
| (succ k) f := ∃x : α, vector_ex k (λv, f (x :: v))

/-- "Curried" forall, i.e. ∀ x1 ... xn, f [x1, ..., xn] -/
def vector_all {α} : Π k, (vector3 α k → Prop) → Prop
| 0        f := f []
| (succ k) f := ∀x : α, vector_all k (λv, f (x :: v))

theorem exists_vector_zero {α} (f : vector3 α 0 → Prop) : Exists f ↔ f [] :=
⟨λ⟨v, fv⟩, by rw ← (eq_nil v); exact fv, λf0, ⟨[], f0⟩⟩

theorem exists_vector_succ {α n} (f : vector3 α (succ n) → Prop) : Exists f ↔ ∃x v, f (x :: v) :=
⟨λ⟨v, fv⟩, ⟨_, _, by rw cons_head_tail v; exact fv⟩, λ⟨x, v, fxv⟩, ⟨_, fxv⟩⟩

theorem vector_ex_iff_exists {α} : ∀ {n} (f : vector3 α n → Prop), vector_ex n f ↔ Exists f
| 0        f := (exists_vector_zero f).symm
| (succ n) f := iff.trans (exists_congr (λx, vector_ex_iff_exists _)) (exists_vector_succ f).symm

theorem vector_all_iff_forall {α} : ∀ {n} (f : vector3 α n → Prop), vector_all n f ↔ ∀ v, f v
| 0        f := ⟨λf0 v, v.nil_elim f0, λal, al []⟩
| (succ n) f := (forall_congr (λx, vector_all_iff_forall (λv, f (x :: v)))).trans
  ⟨λal v, v.cons_elim al, λal x v, al (x::v)⟩

/-- `vector_allp p v` is equivalent to `∀ i, p (v i)`, but unfolds directly to a conjunction,
  i.e. `vector_allp p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
def vector_allp {α} (p : α → Prop) {n} (v : vector3 α n) : Prop :=
vector3.rec_on v true (λn a v IH, @vector3.rec_on _ (λn v, Prop) _ v (p a) (λn b v' _, p a ∧ IH))

@[simp] theorem vector_allp_nil {α} (p : α → Prop) : vector_allp p [] = true := rfl
@[simp] theorem vector_allp_singleton {α} (p : α → Prop) (x : α) : vector_allp p [x] = p x := rfl
@[simp] theorem vector_allp_cons {α} (p : α → Prop) {n} (x : α) (v : vector3 α n) :
  vector_allp p (x :: v) ↔ p x ∧ vector_allp p v :=
vector3.rec_on v (and_true _).symm (λn a v IH, iff.rfl)

theorem vector_allp_iff_forall {α} (p : α → Prop) {n} (v : vector3 α n) : vector_allp p v ↔ ∀ i, p (v i) :=
begin refine v.rec_on _ _,
  { exact ⟨λ_, fin2.elim0, λ_, trivial⟩ },
  { simp, refine λn a v IH, (and_congr_right (λ_, IH)).trans
      ⟨λ⟨pa, h⟩ i, by {refine i.cases' _ _, exacts [pa, h]}, λh, ⟨_, λi, _⟩⟩,
    { have h0 := h fz, simp at h0, exact h0 },
    { have hs := h (fs i), simp at hs, exact hs } }
end

theorem vector_allp.imp {α} {p q : α → Prop} (h : ∀ x, p x → q x)
  {n} {v : vector3 α n} (al : vector_allp p v) : vector_allp q v :=
(vector_allp_iff_forall _ _).2 (λi, h _ $ (vector_allp_iff_forall _ _).1 al _)

/-- `list_all p l` is equivalent to `∀ a ∈ l, p a`, but unfolds directly to a conjunction,
  i.e. `list_all p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
@[simp] def list_all {α} (p : α → Prop) : list α → Prop
| []        := true
| (x :: []) := p x
| (x :: l)  := p x ∧ list_all l

@[simp] theorem list_all_cons {α} (p : α → Prop) (x : α) : ∀ (l : list α), list_all p (x :: l) ↔ p x ∧ list_all p l
| []       := (and_true _).symm
| (x :: l) := iff.rfl

theorem list_all_iff_forall {α} (p : α → Prop) : ∀ (l : list α), list_all p l ↔ ∀ x ∈ l, p x
| []       := (iff_true_intro $ list.ball_nil _).symm
| (x :: l) := by rw [list.ball_cons, ← list_all_iff_forall l]; simp

theorem list_all.imp {α} {p q : α → Prop} (h : ∀ x, p x → q x) : ∀ {l : list α}, list_all p l → list_all q l
| []       := id
| (x :: l) := by simpa using and.imp (h x) list_all.imp

@[simp] theorem list_all_map {α β} {p : β → Prop} (f : α → β) {l : list α} : list_all p (l.map f) ↔ list_all (p ∘ f) l :=
by induction l; simp *

theorem list_all_congr {α} {p q : α → Prop} (h : ∀ x, p x ↔ q x) {l : list α} : list_all p l ↔ list_all q l :=
⟨list_all.imp (λx, (h x).1), list_all.imp (λx, (h x).2)⟩

instance decidable_list_all {α} (p : α → Prop) [decidable_pred p] (l : list α) : decidable (list_all p l) :=
decidable_of_decidable_of_iff (by apply_instance) (list_all_iff_forall _ _).symm

/- poly -/

/-- A predicate asserting that a function is a multivariate integer polynomial.
  (We are being a bit lazy here by allowing many representations for multiplication,
  rather than only allowing monomials and addition, but the definition is equivalent
  and this is easier to use.) -/
inductive is_poly {α} : ((α → ℕ) → ℤ) → Prop
| proj : ∀ i, is_poly (λx : α → ℕ, x i)
| const : Π (n : ℤ), is_poly (λx : α → ℕ, n)
| sub : Π {f g : (α → ℕ) → ℤ}, is_poly f → is_poly g → is_poly (λx, f x - g x)
| mul : Π {f g : (α → ℕ) → ℤ}, is_poly f → is_poly g → is_poly (λx, f x * g x)

/-- The type of multivariate integer polynomials -/
def poly (α : Type u) := {f : (α → ℕ) → ℤ // is_poly f}

namespace poly
section
parameter {α : Type u}

instance : has_coe_to_fun (poly α) := ⟨_, λ f, f.1⟩

/-- The underlying function of a `poly` is a polynomial -/
def isp (f : poly α) : is_poly f := f.2

/-- Extensionality for `poly α` -/
def ext {f g : poly α} (e : ∀x, f x = g x) : f = g :=
subtype.eq (funext e)

/-- Construct a `poly` given an extensionally equivalent `poly`. -/
def subst (f : poly α) (g : (α → ℕ) → ℤ) (e : ∀x, f x = g x) : poly α :=
⟨g, by rw ← (funext e : coe_fn f = g); exact f.isp⟩
@[simp] theorem subst_eval (f g e x) : subst f g e x = g x := rfl

/-- The `i`th projection function, `x_i`. -/
def proj (i) : poly α := ⟨_, is_poly.proj i⟩
@[simp] theorem proj_eval (i x) : proj i x = x i := rfl

/-- The constant function with value `n : ℤ`. -/
def const (n) : poly α := ⟨_, is_poly.const n⟩
@[simp] theorem const_eval (n x) : const n x = n := rfl

/-- The zero polynomial -/
def zero : poly α := const 0
instance : has_zero (poly α) := ⟨poly.zero⟩
@[simp] theorem zero_eval (x) : (0 : poly α) x = 0 := rfl

/-- The zero polynomial -/
def one : poly α := const 1
instance : has_one (poly α) := ⟨poly.one⟩
@[simp] theorem one_eval (x) : (1 : poly α) x = 1 := rfl

/-- Subtraction of polynomials -/
def sub : poly α → poly α → poly α | ⟨f, pf⟩ ⟨g, pg⟩ :=
⟨_, is_poly.sub pf pg⟩
instance : has_sub (poly α) := ⟨poly.sub⟩
@[simp] theorem sub_eval : Π (f g x), (f - g : poly α) x = f x - g x
| ⟨f, pf⟩ ⟨g, pg⟩ x := rfl

/-- Negation of a polynomial -/
def neg (f : poly α) : poly α := 0 - f
instance : has_neg (poly α) := ⟨poly.neg⟩
@[simp] theorem neg_eval (f x) : (-f : poly α) x = -f x :=
show (0-f) x = _, by simp

/-- Addition of polynomials -/
def add : poly α → poly α → poly α | ⟨f, pf⟩ ⟨g, pg⟩ :=
subst (⟨f, pf⟩ - -⟨g, pg⟩) _
 (λx, show f x - (0 - g x) = f x + g x, by simp)
instance : has_add (poly α) := ⟨poly.add⟩
@[simp] theorem add_eval : Π (f g x), (f + g : poly α) x = f x + g x
| ⟨f, pf⟩ ⟨g, pg⟩ x := rfl

/-- Multiplication of polynomials -/
def mul : poly α → poly α → poly α | ⟨f, pf⟩ ⟨g, pg⟩ :=
⟨_, is_poly.mul pf pg⟩
instance : has_mul (poly α) := ⟨poly.mul⟩
@[simp] theorem mul_eval : Π (f g x), (f * g : poly α) x = f x * g x
| ⟨f, pf⟩ ⟨g, pg⟩ x := rfl

instance : comm_ring (poly α) := by refine
{ add  := (+),
  zero := 0,
  neg  := has_neg.neg,
  mul  := (*),
  one  := 1, .. }; {intros, exact ext (λx, by simp [mul_add, mul_left_comm, mul_comm])}

def induction {C : poly α → Prop}
  (H1 : ∀i, C (proj i)) (H2 : ∀n, C (const n))
  (H3 : ∀f g, C f → C g → C (f - g))
  (H4 : ∀f g, C f → C g → C (f * g)) (f : poly α) : C f :=
begin
  cases f with f pf,
  induction pf with i n f g pf pg ihf ihg f g pf pg ihf ihg,
  apply H1, apply H2, apply H3 _ _ ihf ihg, apply H4 _ _ ihf ihg
end

/-- The sum of squares of a list of polynomials. This is relevant for
  Diophantine equations, because it means that a list of equations
  can be encoded as a single equation: `x = 0 ∧ y = 0 ∧ z = 0` is
  equivalent to `x^2 + y^2 + z^2 = 0`. -/
def sumsq : list (poly α) → poly α
| []      := 0
| (p::ps) := p*p + sumsq ps

theorem sumsq_nonneg (x) : ∀ l, 0 ≤ sumsq l x
| []      := le_refl 0
| (p::ps) := by rw sumsq; simp [-add_comm];
                exact add_nonneg (mul_self_nonneg _) (sumsq_nonneg ps)

theorem sumsq_eq_zero (x) : ∀ l, sumsq l x = 0 ↔ list_all (λa : poly α, a x = 0) l
| []      := eq_self_iff_true _
| (p::ps) := by rw [list_all_cons, ← sumsq_eq_zero ps]; rw sumsq; simp [-add_comm]; exact
  ⟨λ(h : p x * p x + sumsq ps x = 0),
   have p x = 0, from eq_zero_of_mul_self_eq_zero $ le_antisymm
     (by rw ← h; have t := add_le_add_left (sumsq_nonneg x ps) (p x * p x); rwa [add_zero] at t)
     (mul_self_nonneg _),
   ⟨this, by simp [this] at h; exact h⟩,
  λ⟨h1, h2⟩, by rw [h1, h2]; refl⟩

end

/-- Map the index set of variables, replacing `x_i` with `x_(f i)`. -/
def remap {α β} (f : α → β) (g : poly α) : poly β :=
⟨λv, g $ v ∘ f, g.induction
  (λi, by simp; apply is_poly.proj)
  (λn, by simp; apply is_poly.const)
  (λf g pf pg, by simp; apply is_poly.sub pf pg)
  (λf g pf pg, by simp; apply is_poly.mul pf pg)⟩
@[simp] theorem remap_eval {α β} (f : α → β) (g : poly α) (v) : remap f g v = g (v ∘ f) := rfl

end poly

namespace sum

/-- combine two functions into a function on the disjoint union -/
def join {α β γ} (f : α → γ) (g : β → γ) : α ⊕ β → γ :=
by {refine sum.rec _ _, exacts [f, g]}

end sum

local infixr ` ⊗ `:65 := sum.join

open sum

namespace option

/-- Functions from `option` can be combined similarly to `vector.cons` -/
def cons {α β} (a : β) (v : α → β) : option α → β :=
by {refine option.rec _ _, exacts [a, v]}

notation a :: b := cons a b

@[simp] theorem cons_head_tail {α β} (v : option α → β) : v none :: v ∘ some = v :=
funext $ λo, by cases o; refl
end option

/- dioph -/

/-- A set `S ⊆ ℕ^α` is diophantine if there exists a polynomial on
  `α ⊕ β` such that `v ∈ S` iff there exists `t : ℕ^β` with `p (v, t) = 0`. -/
def dioph {α : Type u} (S : set (α → ℕ)) : Prop :=
∃ {β : Type u} (p : poly (α ⊕ β)), ∀ (v : α → ℕ), S v ↔ ∃t, p (v ⊗ t) = 0

namespace dioph
section
  variables {α β γ : Type u}

  theorem ext {S S' : set (α → ℕ)} (d : dioph S) (H : ∀v, S v ↔ S' v) : dioph S' :=
  eq.rec d $ show S = S', from set.ext H

  theorem of_no_dummies (S : set (α → ℕ)) (p : poly α) (h : ∀ (v : α → ℕ), S v ↔ p v = 0) : dioph S :=
  ⟨ulift empty, p.remap inl, λv, (h v).trans
    ⟨λh, ⟨λt, empty.rec _ t.down, by simp; rw [
      show (v ⊗ λt:ulift empty, empty.rec _ t.down) ∘ inl = v, from rfl, h]⟩,
    λ⟨t, ht⟩, by simp at ht; rwa [show (v ⊗ t) ∘ inl = v, from rfl] at ht⟩⟩

  lemma inject_dummies_lem (f : β → γ) (g : γ → option β) (inv : ∀ x, g (f x) = some x)
    (p : poly (α ⊕ β)) (v : α → ℕ) : (∃t, p (v ⊗ t) = 0) ↔
      (∃t, p.remap (inl ⊗ (inr ∘ f)) (v ⊗ t) = 0) :=
  begin
    simp, refine ⟨λt, _, λt, _⟩; cases t with t ht,
    { have : (v ⊗ (0 :: t) ∘ g) ∘ (inl ⊗ inr ∘ f) = v ⊗ t :=
      funext (λs, by cases s with a b; dsimp [join, (∘)]; try {rw inv}; refl),
      exact ⟨(0 :: t) ∘ g, by rwa this⟩ },
    { have : v ⊗ t ∘ f = (v ⊗ t) ∘ (inl ⊗ inr ∘ f) :=
      funext (λs, by cases s with a b; refl),
      exact ⟨t ∘ f, by rwa this⟩ }
  end

  theorem inject_dummies {S : set (α → ℕ)} (f : β → γ) (g : γ → option β) (inv : ∀ x, g (f x) = some x)
    (p : poly (α ⊕ β)) (h : ∀ (v : α → ℕ), S v ↔ ∃t, p (v ⊗ t) = 0) :
    ∃ q : poly (α ⊕ γ), ∀ (v : α → ℕ), S v ↔ ∃t, q (v ⊗ t) = 0 :=
  ⟨p.remap (inl ⊗ (inr ∘ f)), λv, (h v).trans $ inject_dummies_lem f g inv _ _⟩

  theorem reindex_dioph {S : set (α → ℕ)} : Π (d : dioph S) (f : α → β), dioph (λv, S (v ∘ f))
  | ⟨γ, p, pe⟩ f := ⟨γ, p.remap ((inl ∘ f) ⊗ inr), λv, (pe _).trans $ exists_congr $ λt,
    suffices v ∘ f ⊗ t = (v ⊗ t) ∘ (inl ∘ f ⊗ inr), by simp [this],
    funext $ λs, by cases s with a b; refl⟩

  theorem dioph_list_all (l) (d : list_all dioph l) : dioph (λv, list_all (λS : set (α → ℕ), S v) l) :=
  suffices ∃ β (pl : list (poly (α ⊕ β))), ∀ v, list_all (λS : set _, S v) l ↔ ∃t, list_all (λp : poly (α ⊕ β), p (v ⊗ t) = 0) pl,
    from let ⟨β, pl, h⟩ := this in ⟨β, poly.sumsq pl, λv, (h v).trans $ exists_congr $ λt, (poly.sumsq_eq_zero _ _).symm⟩,
  begin
    induction l with S l IH,
    exact ⟨ulift empty, [], λv, by simp; exact ⟨λ⟨t⟩, empty.rec _ t, trivial⟩⟩,
    simp at d,
    exact let ⟨⟨β, p, pe⟩, dl⟩ := d, ⟨γ, pl, ple⟩ := IH dl in
    ⟨β ⊕ γ, p.remap (inl ⊗ inr ∘ inl) :: pl.map (λq, q.remap (inl ⊗ (inr ∘ inr))), λv,
      by simp; exact iff.trans (and_congr (pe v) (ple v))
      ⟨λ⟨⟨m, hm⟩, ⟨n, hn⟩⟩,
        ⟨m ⊗ n, by rw [
          show (v ⊗ m ⊗ n) ∘ (inl ⊗ inr ∘ inl) = v ⊗ m,
          from funext $ λs, by cases s with a b; refl]; exact hm,
        by { refine list_all.imp (λq hq, _) hn, dsimp [(∘)],
             rw [show (λ (x : α ⊕ γ), (v ⊗ m ⊗ n) ((inl ⊗ λ (x : γ), inr (inr x)) x)) = v ⊗ n,
                 from funext $ λs, by cases s with a b; refl]; exact hq }⟩,
      λ⟨t, hl, hr⟩,
        ⟨⟨t ∘ inl, by rwa [
          show (v ⊗ t) ∘ (inl ⊗ inr ∘ inl) = v ⊗ t ∘ inl,
          from funext $ λs, by cases s with a b; refl] at hl⟩,
        ⟨t ∘ inr, by {
          refine list_all.imp (λq hq, _) hr, dsimp [(∘)] at hq,
          rwa [show (λ (x : α ⊕ γ), (v ⊗ t) ((inl ⊗ λ (x : γ), inr (inr x)) x)) = v ⊗ t ∘ inr,
               from funext $ λs, by cases s with a b; refl] at hq }⟩⟩⟩⟩
  end

  theorem and_dioph {S S' : set (α → ℕ)} (d : dioph S) (d' : dioph S') : dioph (λv, S v ∧ S' v) :=
  dioph_list_all [S, S'] ⟨d, d'⟩

  theorem or_dioph {S S' : set (α → ℕ)} : ∀ (d : dioph S) (d' : dioph S'), dioph (λv, S v ∨ S' v)
  | ⟨β, p, pe⟩ ⟨γ, q, qe⟩ := ⟨β ⊕ γ, p.remap (inl ⊗ inr ∘ inl) * q.remap (inl ⊗ inr ∘ inr), λv,
    begin
      refine iff.trans (or_congr ((pe v).trans _) ((qe v).trans _)) (exists_or_distrib.symm.trans (exists_congr $ λt,
       (@mul_eq_zero_iff_eq_zero_or_eq_zero _ _ (p ((v ⊗ t) ∘ (inl ⊗ inr ∘ inl))) (q ((v ⊗ t) ∘ (inl ⊗ inr ∘ inr)))).symm)),
      exact inject_dummies_lem _ (some ⊗ (λ_, none)) (λx, rfl) _ _,
      exact inject_dummies_lem _ ((λ_, none) ⊗ some) (λx, rfl) _ _,
    end⟩

  /-- A partial function is Diophantine if its graph is Diophantine. -/
  def dioph_pfun (f : (α → ℕ) →. ℕ) := dioph (λv : option α → ℕ, f.graph (v ∘ some, v none))

  /-- A function is Diophantine if its graph is Diophantine. -/
  def dioph_fn (f : (α → ℕ) → ℕ) := dioph (λv : option α → ℕ, f (v ∘ some) = v none)

  theorem reindex_dioph_fn {f : (α → ℕ) → ℕ} (d : dioph_fn f) (g : α → β) : dioph_fn (λv, f (v ∘ g)) :=
  reindex_dioph d (functor.map g)

  theorem ex_dioph {S : set (α ⊕ β → ℕ)} : dioph S → dioph (λv, ∃x, S (v ⊗ x))
  | ⟨γ, p, pe⟩ := ⟨β ⊕ γ, p.remap ((inl ⊗ inr ∘ inl) ⊗ inr ∘ inr), λv,
    ⟨λ⟨x, hx⟩, let ⟨t, ht⟩ := (pe _).1 hx in ⟨x ⊗ t, by simp; rw [
      show (v ⊗ x ⊗ t) ∘ ((inl ⊗ inr ∘ inl) ⊗ inr ∘ inr) = (v ⊗ x) ⊗ t,
      from funext $ λs, by cases s with a b; try {cases a}; refl]; exact ht⟩,
    λ⟨t, ht⟩, ⟨t ∘ inl, (pe _).2 ⟨t ∘ inr, by simp at ht; rwa [
      show (v ⊗ t) ∘ ((inl ⊗ inr ∘ inl) ⊗ inr ∘ inr) = (v ⊗ t ∘ inl) ⊗ t ∘ inr,
      from funext $ λs, by cases s with a b; try {cases a}; refl] at ht⟩⟩⟩⟩

  theorem ex1_dioph {S : set (option α → ℕ)} : dioph S → dioph (λv, ∃x, S (x :: v))
  | ⟨β, p, pe⟩ := ⟨option β, p.remap (inr none :: inl ⊗ inr ∘ some), λv,
    ⟨λ⟨x, hx⟩, let ⟨t, ht⟩ := (pe _).1 hx in ⟨x :: t, by simp; rw [
      show (v ⊗ x :: t) ∘ (inr none :: inl ⊗ inr ∘ some) = x :: v ⊗ t,
      from funext $ λs, by cases s with a b; try {cases a}; refl]; exact ht⟩,
    λ⟨t, ht⟩, ⟨t none, (pe _).2 ⟨t ∘ some, by simp at ht; rwa [
      show (v ⊗ t) ∘ (inr none :: inl ⊗ inr ∘ some) = t none :: v ⊗ t ∘ some,
      from funext $ λs, by cases s with a b; try {cases a}; refl] at ht⟩⟩⟩⟩

  theorem dom_dioph {f : (α → ℕ) →. ℕ} (d : dioph_pfun f) : dioph f.dom :=
  cast (congr_arg dioph $ set.ext $ λv, (pfun.dom_iff_graph _ _).symm) (ex1_dioph d)

  theorem dioph_fn_iff_pfun (f : (α → ℕ) → ℕ) : dioph_fn f = @dioph_pfun α f :=
  by refine congr_arg dioph (set.ext $ λv, _); exact pfun.lift_graph.symm

  theorem abs_poly_dioph (p : poly α) : dioph_fn (λv, (p v).nat_abs) :=
  by refine of_no_dummies _ ((p.remap some - poly.proj none) * (p.remap some + poly.proj none)) (λv, _);
     apply int.eq_nat_abs_iff_mul

  theorem proj_dioph (i : α) : dioph_fn (λv, v i) :=
  abs_poly_dioph (poly.proj i)

  theorem dioph_pfun_comp1 {S : set (option α → ℕ)} (d : dioph S) {f} (df : dioph_pfun f) :
    dioph (λv : α → ℕ, ∃ h : f.dom v, S (f.fn v h :: v)) :=
  ext (ex1_dioph (and_dioph d df)) $ λv,
  ⟨λ⟨x, hS, (h: Exists _)⟩, by
    rw [show (x :: v) ∘ some = v, from funext $ λs, rfl] at h;
    cases h with hf h; refine ⟨hf, _⟩; rw [pfun.fn, h]; exact hS,
  λ⟨x, hS⟩, ⟨f.fn v x, hS, show Exists _,
    by rw [show (f.fn v x :: v) ∘ some = v, from funext $ λs, rfl]; exact ⟨x, rfl⟩⟩⟩

  theorem dioph_fn_comp1 {S : set (option α → ℕ)} (d : dioph S) {f : (α → ℕ) → ℕ} (df : dioph_fn f) :
    dioph (λv : α → ℕ, S (f v :: v)) :=
  ext (dioph_pfun_comp1 d (cast (dioph_fn_iff_pfun f) df)) $ λv,
  ⟨λ⟨_, h⟩, h, λh, ⟨trivial, h⟩⟩

end

section
  variables {α β γ : Type}

  theorem dioph_fn_vec_comp1 {n} {S : set (vector3 ℕ (succ n))} (d : dioph S) {f : (vector3 ℕ n) → ℕ} (df : dioph_fn f) :
    dioph (λv : vector3 ℕ n, S (cons (f v) v)) :=
  ext (dioph_fn_comp1 (reindex_dioph d (none :: some)) df) $ λv, by rw [
    show option.cons (f v) v ∘ (cons none some) = f v :: v,
    from funext $ λs, by cases s with a b; refl]

  theorem vec_ex1_dioph (n) {S : set (vector3 ℕ (succ n))} (d : dioph S) : dioph (λv : vector3 ℕ n, ∃x, S (x :: v)) :=
  ext (ex1_dioph $ reindex_dioph d (none :: some)) $ λv, exists_congr $ λx, by rw [
    show (option.cons x v) ∘ (cons none some) = x :: v,
    from funext $ λs, by cases s with a b; refl]

  theorem dioph_fn_vec {n} (f : vector3 ℕ n → ℕ) : dioph_fn f ↔ dioph (λv : vector3 ℕ (succ n), f (v ∘ fs) = v fz) :=
  ⟨λh, reindex_dioph h (fz :: fs), λh, reindex_dioph h (none :: some)⟩

  theorem dioph_pfun_vec {n} (f : vector3 ℕ n →. ℕ) : dioph_pfun f ↔ dioph (λv : vector3 ℕ (succ n), f.graph (v ∘ fs, v fz)) :=
  ⟨λh, reindex_dioph h (fz :: fs), λh, reindex_dioph h (none :: some)⟩

  theorem dioph_fn_compn {α : Type} : ∀ {n} {S : set (α ⊕ fin2 n → ℕ)} (d : dioph S) {f : vector3 ((α → ℕ) → ℕ) n} (df : vector_allp dioph_fn f),
    dioph (λv : α → ℕ, S (v ⊗ λi, f i v))
  | 0 S d f := λdf, ext (reindex_dioph d (id ⊗ fin2.elim0)) $ λv,
    by refine eq.to_iff (congr_arg S $ funext $ λs, _); {cases s with a b, refl, cases b}
  | (succ n) S d f := f.cons_elim $ λf fl, by simp; exact λ df dfl,
    have dioph (λv, S (v ∘ inl ⊗ f (v ∘ inl) :: v ∘ inr)),
    from ext (dioph_fn_comp1 (reindex_dioph d (some ∘ inl ⊗ none :: some ∘ inr)) (reindex_dioph_fn df inl)) $
      λv, by {refine eq.to_iff (congr_arg S $ funext $ λs, _); cases s with a b, refl, cases b; refl},
    have dioph (λv, S (v ⊗ f v :: λ (i : fin2 n), fl i v)),
    from @dioph_fn_compn n (λv, S (v ∘ inl ⊗ f (v ∘ inl) :: v ∘ inr)) this _ dfl,
    ext this $ λv, by rw [
      show cons (f v) (λ (i : fin2 n), fl i v) = λ (i : fin2 (succ n)), (f :: fl) i v,
      from funext $ λs, by cases s with a b; refl]

  theorem dioph_comp {n} {S : set (vector3 ℕ n)} (d : dioph S)
    (f : vector3 ((α → ℕ) → ℕ) n) (df : vector_allp dioph_fn f) : dioph (λv, S (λi, f i v)) :=
  dioph_fn_compn (reindex_dioph d inr) df

  theorem dioph_fn_comp {n} {f : vector3 ℕ n → ℕ} (df : dioph_fn f)
    (g : vector3 ((α → ℕ) → ℕ) n) (dg : vector_allp dioph_fn g) : dioph_fn (λv, f (λi, g i v)) :=
  dioph_comp ((dioph_fn_vec _).1 df) ((λv, v none) :: λi v, g i (v ∘ some)) $
  by simp; exact ⟨proj_dioph none, (vector_allp_iff_forall _ _).2 $ λi,
    reindex_dioph_fn ((vector_allp_iff_forall _ _).1 dg _) _⟩

  local notation x ` D∧ `:35 y := and_dioph x y
  local notation x ` D∨ `:35 y := or_dioph x y

  local notation `D∃`:30 := vec_ex1_dioph

  local prefix `&`:max := of_nat'
  theorem proj_dioph_of_nat {n : ℕ} (m : ℕ) [is_lt m n] : dioph_fn (λv : vector3 ℕ n, v &m) :=
  proj_dioph &m
  local prefix `D&`:100 := proj_dioph_of_nat

  theorem const_dioph (n : ℕ) : dioph_fn (const (α → ℕ) n) :=
  abs_poly_dioph (poly.const n)
  local prefix `D.`:100 := const_dioph

  variables {f g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g)
  include df dg

  theorem dioph_comp2 {S : ℕ → ℕ → Prop} (d : dioph (λv:vector3 ℕ 2, S (v &0) (v &1))) :
    dioph (λv, S (f v) (g v)) :=
  dioph_comp d [f, g] (by exact ⟨df, dg⟩)

  theorem dioph_fn_comp2 {h : ℕ → ℕ → ℕ} (d : dioph_fn (λv:vector3 ℕ 2, h (v &0) (v &1))) :
    dioph_fn (λv, h (f v) (g v)) :=
  dioph_fn_comp d [f, g] (by exact ⟨df, dg⟩)

  theorem eq_dioph : dioph (λv, f v = g v) :=
  dioph_comp2 df dg $ of_no_dummies _ (poly.proj &0 - poly.proj &1)
    (λv, (int.coe_nat_eq_coe_nat_iff _ _).symm.trans
    ⟨@sub_eq_zero_of_eq ℤ _ (v &0) (v &1), eq_of_sub_eq_zero⟩)
  local infix ` D= `:50 := eq_dioph

  theorem add_dioph : dioph_fn (λv, f v + g v) :=
  dioph_fn_comp2 df dg $ abs_poly_dioph (poly.proj &0 + poly.proj &1)
  local infix ` D+ `:80 := add_dioph

  theorem mul_dioph : dioph_fn (λv, f v * g v) :=
  dioph_fn_comp2 df dg $ abs_poly_dioph (poly.proj &0 * poly.proj &1)
  local infix ` D* `:90 := mul_dioph

  theorem le_dioph : dioph (λv, f v ≤ g v) :=
  dioph_comp2 df dg $ ext (D∃2 $ D&1 D+ D&0 D= D&2) (λv, ⟨λ⟨x, hx⟩, le.intro hx, le.dest⟩)
  local infix ` D≤ `:50 := le_dioph

  theorem lt_dioph : dioph (λv, f v < g v) := df D+ (D. 1) D≤ dg
  local infix ` D< `:50 := lt_dioph

  theorem ne_dioph : dioph (λv, f v ≠ g v) :=
  ext (df D< dg D∨ dg D< df) $ λv, ne_iff_lt_or_gt.symm
  local infix ` D≠ `:50 := ne_dioph

  theorem sub_dioph : dioph_fn (λv, f v - g v) :=
  dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $
  ext (D&1 D= D&0 D+ D&2 D∨ D&1 D≤ D&2 D∧ D&0 D= D.0) $ (vector_all_iff_forall _).1 $ λx y z,
  show (y = x + z ∨ y ≤ z ∧ x = 0) ↔ y - z = x, from
  ⟨λo, begin
    rcases o with ae | ⟨yz, x0⟩,
    { rw [ae, nat.add_sub_cancel] },
    { rw [x0, nat.sub_eq_zero_of_le yz] }
  end, λh, begin
    subst x,
    cases le_total y z with yz zy,
    { exact or.inr ⟨yz, nat.sub_eq_zero_of_le yz⟩ },
    { exact or.inl (nat.sub_add_cancel zy).symm },
  end⟩
  local infix ` D- `:80 := sub_dioph

  theorem dvd_dioph : dioph (λv, f v ∣ g v) :=
  dioph_comp (D∃2 $ D&2 D= D&1 D* D&0) [f, g] (by exact ⟨df, dg⟩)
  local infix ` D∣ `:50 := dvd_dioph

  theorem mod_dioph : dioph_fn (λv, f v % g v) :=
  have dioph (λv : vector3 ℕ 3, (v &2 = 0 ∨ v &0 < v &2) ∧ ∃ (x : ℕ), v &0 + v &2 * x = v &1),
  from (D&2 D= D.0 D∨ D&0 D< D&2) D∧ (D∃3 $ D&1 D+ D&3 D* D&0 D= D&2),
  dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $ ext this $ (vector_all_iff_forall _).1 $ λz x y,
  show ((y = 0 ∨ z < y) ∧ ∃ c, z + y * c = x) ↔ x % y = z, from
  ⟨λ⟨h, c, hc⟩, begin rw ← hc; simp; cases h with x0 hl, rw [x0, mod_zero], exact mod_eq_of_lt hl end,
  λe, by rw ← e; exact ⟨or_iff_not_imp_left.2 $ λh, mod_lt _ (nat.pos_of_ne_zero h), x / y, mod_add_div _ _⟩⟩
  local infix ` D% `:80 := mod_dioph

  theorem modeq_dioph {h : (α → ℕ) → ℕ} (dh : dioph_fn h) : dioph (λv, f v ≡ g v [MOD h v]) :=
  df D% dh D= dg D% dh
  local notation `D≡` := modeq_dioph

  theorem div_dioph : dioph_fn (λv, f v / g v) :=
  have dioph (λv : vector3 ℕ 3, v &2 = 0 ∧ v &0 = 0 ∨ v &0 * v &2 ≤ v &1 ∧ v &1 < (v &0 + 1) * v &2),
  from (D&2 D= D.0 D∧ D&0 D= D.0) D∨ D&0 D* D&2 D≤ D&1 D∧ D&1 D< (D&0 D+ D.1) D* D&2,
  dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $ ext this $ (vector_all_iff_forall _).1 $ λz x y,
  show y = 0 ∧ z = 0 ∨ z * y ≤ x ∧ x < (z + 1) * y ↔ x / y = z,
  by refine iff.trans _ eq_comm; exact y.eq_zero_or_pos.elim
    (λy0, by rw [y0, nat.div_zero]; exact
      ⟨λo, (o.resolve_right $ λ⟨_, h2⟩, not_lt_zero _ h2).right, λz0, or.inl ⟨rfl, z0⟩⟩)
    (λypos, iff.trans ⟨λo, o.resolve_left $ λ⟨h1, _⟩, ne_of_gt ypos h1, or.inr⟩
      (le_antisymm_iff.trans $ and_congr (nat.le_div_iff_mul_le _ _ ypos) $
        iff.trans ⟨lt_succ_of_le, le_of_lt_succ⟩ (div_lt_iff_lt_mul _ _ ypos)).symm)
  local infix ` D/ `:80 := div_dioph

  omit df dg
  open pell

  theorem pell_dioph : dioph (λv:vector3 ℕ 4, ∃ h : v &0 > 1,
    xn h (v &1) = v &2 ∧ yn h (v &1) = v &3) :=
  have dioph {v : vector3 ℕ 4 |
  v &0 > 1 ∧ v &1 ≤ v &3 ∧
  (v &2 = 1 ∧ v &3 = 0 ∨
  ∃ (u w s t b : ℕ),
    v &2 * v &2 - (v &0 * v &0 - 1) * v &3 * v &3 = 1 ∧
    u * u - (v &0 * v &0 - 1) * w * w = 1 ∧
    s * s - (b * b - 1) * t * t = 1 ∧
    b > 1 ∧ (b ≡ 1 [MOD 4 * v &3]) ∧ (b ≡ v &0 [MOD u]) ∧
    w > 0 ∧ v &3 * v &3 ∣ w ∧
    (s ≡ v &2 [MOD u]) ∧
    (t ≡ v &1 [MOD 4 * v &3]))}, from
  D.1 D< D&0 D∧ D&1 D≤ D&3 D∧
  ((D&2 D= D.1 D∧ D&3 D= D.0) D∨
   (D∃4 $ D∃5 $ D∃6 $ D∃7 $ D∃8 $
    D&7 D* D&7 D- (D&5 D* D&5 D- D.1) D* D&8 D* D&8 D= D.1 D∧
    D&4 D* D&4 D- (D&5 D* D&5 D- D.1) D* D&3 D* D&3 D= D.1 D∧
    D&2 D* D&2 D- (D&0 D* D&0 D- D.1) D* D&1 D* D&1 D= D.1 D∧
    D.1 D< D&0 D∧ (D≡ (D&0) (D.1) (D.4 D* D&8)) D∧ (D≡ (D&0) (D&5) D&4) D∧
    D.0 D< D&3 D∧ D&8 D* D&8 D∣ D&3 D∧
    (D≡ (D&2) (D&7) D&4) D∧
    (D≡ (D&1) (D&6) (D.4 D* D&8)))),
  dioph.ext this $ λv, matiyasevic.symm

  theorem xn_dioph : dioph_pfun (λv:vector3 ℕ 2, ⟨v &0 > 1, λh, xn h (v &1)⟩) :=
  have dioph (λv:vector3 ℕ 3, ∃ y, ∃ h : v &1 > 1, xn h (v &2) = v &0 ∧ yn h (v &2) = y), from
  let D_pell := @reindex_dioph _ (fin2 4) _ pell_dioph [&2, &3, &1, &0] in D∃3 D_pell,
  (dioph_pfun_vec _).2 $ dioph.ext this $ λv, ⟨λ⟨y, h, xe, ye⟩, ⟨h, xe⟩, λ⟨h, xe⟩, ⟨_, h, xe, rfl⟩⟩

  include df dg
  theorem pow_dioph : dioph_fn (λv, f v ^ g v) :=
  have dioph {v : vector3 ℕ 3 |
  v &2 = 0 ∧ v &0 = 1 ∨ v &2 > 0 ∧
  (v &1 = 0 ∧ v &0 = 0 ∨ v &1 > 0 ∧
  ∃ (w a t z x y : ℕ),
    (∃ (a1 : a > 1), xn a1 (v &2) = x ∧ yn a1 (v &2) = y) ∧
    (x ≡ y * (a - v &1) + v &0 [MOD t]) ∧
    2 * a * v &1 = t + (v &1 * v &1 + 1) ∧
    v &0 < t ∧ v &1 ≤ w ∧ v &2 ≤ w ∧
    a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1)}, from
  let D_pell := @reindex_dioph _ (fin2 9) _ pell_dioph [&4, &8, &1, &0] in
  (D&2 D= D.0 D∧ D&0 D= D.1) D∨ (D.0 D< D&2 D∧
  ((D&1 D= D.0 D∧ D&0 D= D.0) D∨ (D.0 D< D&1 D∧
   (D∃3 $ D∃4 $ D∃5 $ D∃6 $ D∃7 $ D∃8 $ D_pell D∧
    (D≡ (D&1) (D&0 D* (D&4 D- D&7) D+ D&6) (D&3)) D∧
    D.2 D* D&4 D* D&7 D= D&3 D+ (D&7 D* D&7 D+ D.1) D∧
    D&6 D< D&3 D∧ D&7 D≤ D&5 D∧ D&8 D≤ D&5 D∧
    D&4 D* D&4 D- ((D&5 D+ D.1) D* (D&5 D+ D.1) D- D.1) D* (D&5 D* D&2) D* (D&5 D* D&2) D= D.1)))),
  dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $ dioph.ext this $ λv, iff.symm $
  eq_pow_of_pell.trans $ or_congr iff.rfl $ and_congr iff.rfl $ or_congr iff.rfl $ and_congr iff.rfl $
  ⟨λ⟨w, a, t, z, a1, h⟩, ⟨w, a, t, z, _, _, ⟨a1, rfl, rfl⟩, h⟩,
   λ⟨w, a, t, z, ._, ._, ⟨a1, rfl, rfl⟩, h⟩, ⟨w, a, t, z, a1, h⟩⟩

end
end dioph


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.Lean3Lib.data.rbtree.basic

universes u

namespace Mathlib

namespace rbnode

theorem find.induction {α : Type u} {p : rbnode α → Prop} (lt : α → α → Prop) [DecidableRel lt] (t : rbnode α) (x : α) (h₁ : p leaf) (h₂ : ∀ (l : rbnode α) (y : α) (r : rbnode α), cmp_using lt x y = ordering.lt → p l → p (red_node l y r)) (h₃ : ∀ (l : rbnode α) (y : α) (r : rbnode α), cmp_using lt x y = ordering.eq → p (red_node l y r)) (h₄ : ∀ (l : rbnode α) (y : α) (r : rbnode α), cmp_using lt x y = ordering.gt → p r → p (red_node l y r)) (h₅ : ∀ (l : rbnode α) (y : α) (r : rbnode α), cmp_using lt x y = ordering.lt → p l → p (black_node l y r)) (h₆ : ∀ (l : rbnode α) (y : α) (r : rbnode α), cmp_using lt x y = ordering.eq → p (black_node l y r)) (h₇ : ∀ (l : rbnode α) (y : α) (r : rbnode α), cmp_using lt x y = ordering.gt → p r → p (black_node l y r)) : p t := sorry

theorem find_correct {α : Type u} {t : rbnode α} {lt : α → α → Prop} {x : α} [DecidableRel lt] [is_strict_weak_order α lt] {lo : Option α} {hi : Option α} (hs : is_searchable lt t lo hi) : mem lt x t ↔ ∃ (y : α), find lt t x = some y ∧ strict_weak_order.equiv x y := sorry

theorem mem_of_mem_exact {α : Type u} {lt : α → α → Prop} [is_irrefl α lt] {x : α} {t : rbnode α} : mem_exact x t → mem lt x t := sorry

theorem find_correct_exact {α : Type u} {t : rbnode α} {lt : α → α → Prop} {x : α} [DecidableRel lt] [is_strict_weak_order α lt] {lo : Option α} {hi : Option α} (hs : is_searchable lt t lo hi) : mem_exact x t ↔ find lt t x = some x := sorry

theorem eqv_of_find_some {α : Type u} {t : rbnode α} {lt : α → α → Prop} {x : α} {y : α} [DecidableRel lt] [is_strict_weak_order α lt] {lo : Option α} {hi : Option α} (hs : is_searchable lt t lo hi) (he : find lt t x = some y) : strict_weak_order.equiv x y := sorry

theorem find_eq_find_of_eqv {α : Type u} {lt : α → α → Prop} {a : α} {b : α} [DecidableRel lt] [is_strict_weak_order α lt] {t : rbnode α} {lo : Option α} {hi : Option α} (hs : is_searchable lt t lo hi) (heqv : strict_weak_order.equiv a b) : find lt t a = find lt t b := sorry


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.opens
import Mathlib.ring_theory.ideal.prod
import Mathlib.linear_algebra.finsupp
import Mathlib.algebra.punit_instances
import Mathlib.PostPort

universes u u_1 v

namespace Mathlib

/-!
# Prime spectrum of a commutative ring

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

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

## Main definitions

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

## Conventions

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

## Inspiration/contributors

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

-/

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

It is naturally endowed with a topology (the Zariski topology),
and a sheaf of commutative rings (see `algebraic_geometry.structure_sheaf`).
It is a fundamental building block in algebraic geometry. -/
def prime_spectrum (R : Type u) [comm_ring R] :=
  Subtype fun (I : ideal R) => ideal.is_prime I

namespace prime_spectrum

/-- A method to view a point in the prime spectrum of a commutative ring
as an ideal of that ring. -/
def as_ideal {R : Type u} [comm_ring R] (x : prime_spectrum R) : ideal R :=
  subtype.val x

protected instance is_prime {R : Type u} [comm_ring R] (x : prime_spectrum R) : ideal.is_prime (as_ideal x) :=
  subtype.property x

/--
The prime spectrum of the zero ring is empty.
-/
theorem punit (x : prime_spectrum PUnit) : False :=
  iff.mp (ideal.ne_top_iff_one (subtype.val x)) (and.left (subtype.property x))
    (subsingleton.elim 0 1 ▸ ideal.zero_mem (subtype.val x))

/-- The prime spectrum of `R × S` is in bijection with the disjoint unions of the prime spectrum of
    `R` and the prime spectrum of `S`. -/
def prime_spectrum_prod (R : Type u) [comm_ring R] (S : Type v) [comm_ring S] : prime_spectrum (R × S) ≃ prime_spectrum R ⊕ prime_spectrum S :=
  ideal.prime_ideals_equiv R S

@[simp] theorem prime_spectrum_prod_symm_inl_as_ideal {R : Type u} [comm_ring R] {S : Type v} [comm_ring S] (x : prime_spectrum R) : as_ideal (coe_fn (equiv.symm (prime_spectrum_prod R S)) (sum.inl x)) = ideal.prod (as_ideal x) ⊤ := sorry

@[simp] theorem prime_spectrum_prod_symm_inr_as_ideal {R : Type u} [comm_ring R] {S : Type v} [comm_ring S] (x : prime_spectrum S) : as_ideal (coe_fn (equiv.symm (prime_spectrum_prod R S)) (sum.inr x)) = ideal.prod ⊤ (as_ideal x) := sorry

theorem ext {R : Type u} [comm_ring R] {x : prime_spectrum R} {y : prime_spectrum R} : x = y ↔ as_ideal x = as_ideal y :=
  subtype.ext_iff_val

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

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

@[simp] theorem mem_zero_locus {R : Type u} [comm_ring R] (x : prime_spectrum R) (s : set R) : x ∈ zero_locus s ↔ s ⊆ ↑(as_ideal x) :=
  iff.rfl

@[simp] theorem zero_locus_span {R : Type u} [comm_ring R] (s : set R) : zero_locus ↑(ideal.span s) = zero_locus s :=
  set.ext fun (x : prime_spectrum R) => galois_insertion.gc (submodule.gi R R) s (as_ideal x)

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

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

theorem coe_vanishing_ideal {R : Type u} [comm_ring R] (t : set (prime_spectrum R)) : ↑(vanishing_ideal t) = set_of fun (f : R) => ∀ (x : prime_spectrum R), x ∈ t → f ∈ as_ideal x := sorry

theorem mem_vanishing_ideal {R : Type u} [comm_ring R] (t : set (prime_spectrum R)) (f : R) : f ∈ vanishing_ideal t ↔ ∀ (x : prime_spectrum R), x ∈ t → f ∈ as_ideal x := sorry

theorem subset_zero_locus_iff_le_vanishing_ideal {R : Type u} [comm_ring R] (t : set (prime_spectrum R)) (I : ideal R) : t ⊆ zero_locus ↑I ↔ I ≤ vanishing_ideal t := sorry

/-- `zero_locus` and `vanishing_ideal` form a galois connection. -/
theorem gc (R : Type u) [comm_ring R] : galois_connection (fun (I : ideal R) => zero_locus ↑I)
  fun (t : order_dual (set (prime_spectrum R))) => vanishing_ideal t :=
  fun (I : ideal R) (t : order_dual (set (prime_spectrum R))) => subset_zero_locus_iff_le_vanishing_ideal t I

/-- `zero_locus` and `vanishing_ideal` form a galois connection. -/
theorem gc_set (R : Type u) [comm_ring R] : galois_connection (fun (s : set R) => zero_locus s)
  fun (t : order_dual (set (prime_spectrum R))) => ↑(vanishing_ideal t) := sorry

theorem subset_zero_locus_iff_subset_vanishing_ideal (R : Type u) [comm_ring R] (t : set (prime_spectrum R)) (s : set R) : t ⊆ zero_locus s ↔ s ⊆ ↑(vanishing_ideal t) :=
  gc_set R s t

-- TODO: we actually get the radical ideal,

-- but I think that isn't in mathlib yet.

theorem subset_vanishing_ideal_zero_locus {R : Type u} [comm_ring R] (s : set R) : s ⊆ ↑(vanishing_ideal (zero_locus s)) :=
  galois_connection.le_u_l (gc_set R) s

theorem le_vanishing_ideal_zero_locus {R : Type u} [comm_ring R] (I : ideal R) : I ≤ vanishing_ideal (zero_locus ↑I) :=
  galois_connection.le_u_l (gc R) I

theorem subset_zero_locus_vanishing_ideal {R : Type u} [comm_ring R] (t : set (prime_spectrum R)) : t ⊆ zero_locus ↑(vanishing_ideal t) :=
  galois_connection.l_u_le (gc R) t

theorem zero_locus_bot {R : Type u} [comm_ring R] : zero_locus ↑⊥ = set.univ :=
  galois_connection.l_bot (gc R)

@[simp] theorem zero_locus_singleton_zero {R : Type u} [comm_ring R] : zero_locus 0 = set.univ :=
  zero_locus_bot

@[simp] theorem zero_locus_empty {R : Type u} [comm_ring R] : zero_locus ∅ = set.univ :=
  galois_connection.l_bot (gc_set R)

@[simp] theorem vanishing_ideal_univ {R : Type u} [comm_ring R] : vanishing_ideal ∅ = ⊤ :=
  eq.mpr (id (Eq.refl (vanishing_ideal ∅ = ⊤))) (eq.mp (Eq.refl (vanishing_ideal ⊤ = ⊤)) (galois_connection.u_top (gc R)))

theorem zero_locus_empty_of_one_mem {R : Type u} [comm_ring R] {s : set R} (h : 1 ∈ s) : zero_locus s = ∅ := sorry

theorem zero_locus_empty_iff_eq_top {R : Type u} [comm_ring R] {I : ideal R} : zero_locus ↑I = ∅ ↔ I = ⊤ := sorry

@[simp] theorem zero_locus_univ {R : Type u} [comm_ring R] : zero_locus set.univ = ∅ :=
  zero_locus_empty_of_one_mem (set.mem_univ 1)

theorem zero_locus_sup {R : Type u} [comm_ring R] (I : ideal R) (J : ideal R) : zero_locus ↑(I ⊔ J) = zero_locus ↑I ∩ zero_locus ↑J :=
  galois_connection.l_sup (gc R)

theorem zero_locus_union {R : Type u} [comm_ring R] (s : set R) (s' : set R) : zero_locus (s ∪ s') = zero_locus s ∩ zero_locus s' :=
  galois_connection.l_sup (gc_set R)

theorem vanishing_ideal_union {R : Type u} [comm_ring R] (t : set (prime_spectrum R)) (t' : set (prime_spectrum R)) : vanishing_ideal (t ∪ t') = vanishing_ideal t ⊓ vanishing_ideal t' :=
  galois_connection.u_inf (gc R)

theorem zero_locus_supr {R : Type u} [comm_ring R] {ι : Sort u_1} (I : ι → ideal R) : zero_locus ↑(supr fun (i : ι) => I i) = set.Inter fun (i : ι) => zero_locus ↑(I i) :=
  galois_connection.l_supr (gc R)

theorem zero_locus_Union {R : Type u} [comm_ring R] {ι : Sort u_1} (s : ι → set R) : zero_locus (set.Union fun (i : ι) => s i) = set.Inter fun (i : ι) => zero_locus (s i) :=
  galois_connection.l_supr (gc_set R)

theorem zero_locus_bUnion {R : Type u} [comm_ring R] (s : set (set R)) : zero_locus (set.Union fun (s' : set R) => set.Union fun (H : s' ∈ s) => s') =
  set.Inter fun (s' : set R) => set.Inter fun (H : s' ∈ s) => zero_locus s' := sorry

theorem vanishing_ideal_Union {R : Type u} [comm_ring R] {ι : Sort u_1} (t : ι → set (prime_spectrum R)) : vanishing_ideal (set.Union fun (i : ι) => t i) = infi fun (i : ι) => vanishing_ideal (t i) :=
  galois_connection.u_infi (gc R)

theorem zero_locus_inf {R : Type u} [comm_ring R] (I : ideal R) (J : ideal R) : zero_locus ↑(I ⊓ J) = zero_locus ↑I ∪ zero_locus ↑J := sorry

theorem union_zero_locus {R : Type u} [comm_ring R] (s : set R) (s' : set R) : zero_locus s ∪ zero_locus s' = zero_locus ↑(ideal.span s ⊓ ideal.span s') := sorry

theorem sup_vanishing_ideal_le {R : Type u} [comm_ring R] (t : set (prime_spectrum R)) (t' : set (prime_spectrum R)) : vanishing_ideal t ⊔ vanishing_ideal t' ≤ vanishing_ideal (t ∩ t') := sorry

theorem mem_compl_zero_locus_iff_not_mem {R : Type u} [comm_ring R] {f : R} {I : prime_spectrum R} : I ∈ (zero_locus (singleton f)ᶜ) ↔ ¬f ∈ as_ideal I := sorry

/-- The Zariski topology on the prime spectrum of a commutative ring
is defined via the closed sets of the topology:
they are exactly those sets that are the zero locus of a subset of the ring. -/
protected instance zariski_topology {R : Type u} [comm_ring R] : topological_space (prime_spectrum R) :=
  topological_space.of_closed (set.range zero_locus) sorry sorry sorry

theorem is_open_iff {R : Type u} [comm_ring R] (U : set (prime_spectrum R)) : is_open U ↔ ∃ (s : set R), Uᶜ = zero_locus s := sorry

theorem is_closed_iff_zero_locus {R : Type u} [comm_ring R] (Z : set (prime_spectrum R)) : is_closed Z ↔ ∃ (s : set R), Z = zero_locus s := sorry

theorem is_closed_zero_locus {R : Type u} [comm_ring R] (s : set R) : is_closed (zero_locus s) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_closed (zero_locus s))) (propext (is_closed_iff_zero_locus (zero_locus s)))))
    (Exists.intro s rfl)

/-- The function between prime spectra of commutative rings induced by a ring homomorphism.
This function is continuous. -/
def comap {R : Type u} [comm_ring R] {S : Type v} [comm_ring S] (f : R →+* S) : prime_spectrum S → prime_spectrum R :=
  fun (y : prime_spectrum S) => { val := ideal.comap f (as_ideal y), property := sorry }

@[simp] theorem comap_as_ideal {R : Type u} [comm_ring R] {S : Type v} [comm_ring S] (f : R →+* S) (y : prime_spectrum S) : as_ideal (comap f y) = ideal.comap f (as_ideal y) :=
  rfl

@[simp] theorem comap_id {R : Type u} [comm_ring R] : comap (ring_hom.id R) = id :=
  funext fun (_x : prime_spectrum R) => subtype.ext (ideal.ext fun (_x_1 : R) => iff.rfl)

@[simp] theorem comap_comp {R : Type u} [comm_ring R] {S : Type v} [comm_ring S] {S' : Type u_1} [comm_ring S'] (f : R →+* S) (g : S →+* S') : comap (ring_hom.comp g f) = comap f ∘ comap g :=
  funext fun (_x : prime_spectrum S') => subtype.ext (ideal.ext fun (_x_1 : R) => iff.rfl)

@[simp] theorem preimage_comap_zero_locus {R : Type u} [comm_ring R] {S : Type v} [comm_ring S] (f : R →+* S) (s : set R) : comap f ⁻¹' zero_locus s = zero_locus (⇑f '' s) := sorry

theorem comap_continuous {R : Type u} [comm_ring R] {S : Type v} [comm_ring S] (f : R →+* S) : continuous (comap f) := sorry

theorem zero_locus_vanishing_ideal_eq_closure {R : Type u} [comm_ring R] (t : set (prime_spectrum R)) : zero_locus ↑(vanishing_ideal t) = closure t := sorry

/-- The prime spectrum of a commutative ring is a compact topological space. -/
protected instance compact_space {R : Type u} [comm_ring R] : compact_space (prime_spectrum R) := sorry

/-- `basic_open r` is the open subset containing all prime ideals not containing `r`. -/
def basic_open {R : Type u} [comm_ring R] (r : R) : topological_space.opens (prime_spectrum R) :=
  { val := set_of fun (x : prime_spectrum R) => ¬r ∈ as_ideal x, property := sorry }

theorem is_open_basic_open {R : Type u} [comm_ring R] {a : R} : is_open ↑(basic_open a) :=
  subtype.property (basic_open a)


import data.nat.basic

theorem nat.sum_four_squares (n : ℕ ):
  ∃ (a b c d : ℕ), a^2+b^2+c^2+d^2 = n :=
  sorry