/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.ordmap.ordnode
import Mathlib.algebra.ordered_ring
import Mathlib.data.nat.dist
import Mathlib.tactic.linarith.default
import Mathlib.PostPort

universes u_1 l

namespace Mathlib

/-!
# Verification of the `ordnode α` datatype

This file proves the correctness of the operations in `data.ordmap.ordnode`.
The public facing version is the type `ordset α`, which is a wrapper around
`ordnode α` which includes the correctness invariant of the type, and it exposes
parallel operations like `insert` as functions on `ordset` that do the same
thing but bundle the correctness proofs. The advantage is that it is possible
to, for example, prove that the result of `find` on `insert` will actually find
the element, while `ordnode` cannot guarantee this if the input tree did not
satisfy the type invariants.

## Main definitions

* `ordset α`: A well formed set of values of type `α`

## Implementation notes

The majority of this file is actually in the `ordnode` namespace, because we first
have to prove the correctness of all the operations (and defining what correctness
means here is actually somewhat subtle). So all the actual `ordset` operations are
at the very end, once we have all the theorems.

An `ordnode α` is an inductive type which describes a tree which stores the `size` at
internal nodes. The correctness invariant of an `ordnode α` is:

* `ordnode.sized t`: All internal `size` fields must match the actual measured
  size of the tree. (This is not hard to satisfy.)
* `ordnode.balanced t`: Unless the tree has the form `()` or `((a) b)` or `(a (b))`
  (that is, nil or a single singleton subtree), the two subtrees must satisfy
  `size l ≤ δ * size r` and `size r ≤ δ * size l`, where `δ := 3` is a global
  parameter of the data structure (and this property must hold recursively at subtrees).
  This is why we say this is a "size balanced tree" data structure.
* `ordnode.bounded lo hi t`: The members of the tree must be in strictly increasing order,
  meaning that if `a` is in the left subtree and `b` is the root, then `a ≤ b` and
  `¬ (b ≤ a)`. We enforce this using `ordnode.bounded` which includes also a global
  upper and lower bound.

Because the `ordnode` file was ported from Haskell, the correctness invariants of some
of the functions have not been spelled out, and some theorems like
`ordnode.valid'.balance_l_aux` show very intricate assumptions on the sizes,
which may need to be revised if it turns out some operations violate these assumptions,
because there is a decent amount of slop in the actual data structure invariants, so the
theorem will go through with multiple choices of assumption.

**Note:** This file is incomplete, in the sense that the intent is to have verified
versions and lemmas about all the definitions in `ordnode.lean`, but at the moment only
a few operations are verified (the hard part should be out of the way, but still).
Contributors are encouraged to pick this up and finish the job, if it appeals to you.

## Tags

ordered map, ordered set, data structure, verified programming

-/

namespace ordnode

/-! ### delta and ratio -/

theorem not_le_delta {s : ℕ} (H : 1 ≤ s) : ¬s ≤ delta * 0 :=
  fun (h : s ≤ delta * 0) => not_lt_of_le (eq.mp (Eq._oldrec (Eq.refl (s ≤ delta * 0)) (mul_zero delta)) h) H

theorem delta_lt_false {a : ℕ} {b : ℕ} (h₁ : delta * a < b) (h₂ : delta * b < a) : False := sorry

/-! ### `singleton` -/

/-! ### `size` and `empty` -/

/-- O(n). Computes the actual number of elements in the set, ignoring the cached `size` field. -/
def real_size {α : Type u_1} : ordnode α → ℕ :=
  sorry

/-! ### `sized` -/

/-- The `sized` property asserts that all the `size` fields in nodes match the actual size of the
respective subtrees. -/
def sized {α : Type u_1} : ordnode α → Prop :=
  sorry

theorem sized.node' {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (hl : sized l) (hr : sized r) : sized (node' l x r) :=
  { left := rfl, right := { left := hl, right := hr } }

theorem sized.eq_node' {α : Type u_1} {s : ℕ} {l : ordnode α} {x : α} {r : ordnode α} (h : sized (node s l x r)) : node s l x r = node' l x r :=
  eq.mpr (id (Eq._oldrec (Eq.refl (node s l x r = node' l x r)) (and.left h)))
    (Eq.refl (node (size l + size r + 1) l x r))

theorem sized.size_eq {α : Type u_1} {s : ℕ} {l : ordnode α} {x : α} {r : ordnode α} (H : sized (node s l x r)) : size (node s l x r) = size l + size r + 1 :=
  and.left H

theorem sized.induction {α : Type u_1} {t : ordnode α} (hl : sized t) {C : ordnode α → Prop} (H0 : C nil) (H1 : ∀ (l : ordnode α) (x : α) (r : ordnode α), C l → C r → C (node' l x r)) : C t := sorry

theorem size_eq_real_size {α : Type u_1} {t : ordnode α} : sized t → size t = real_size t := sorry

@[simp] theorem sized.size_eq_zero {α : Type u_1} {t : ordnode α} (ht : sized t) : size t = 0 ↔ t = nil := sorry

theorem sized.pos {α : Type u_1} {s : ℕ} {l : ordnode α} {x : α} {r : ordnode α} (h : sized (node s l x r)) : 0 < s :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 < s)) (and.left h))) (nat.le_add_left (Nat.succ 0) (size l + size r))

/-! `dual` -/

theorem dual_dual {α : Type u_1} (t : ordnode α) : dual (dual t) = t := sorry

@[simp] theorem size_dual {α : Type u_1} (t : ordnode α) : size (dual t) = size t :=
  ordnode.cases_on t (Eq.refl (size (dual nil)))
    fun (t_size : ℕ) (t_l : ordnode α) (t_x : α) (t_r : ordnode α) => Eq.refl (size (dual (node t_size t_l t_x t_r)))

/-! `balanced` -/

/-- The `balanced_sz l r` asserts that a hypothetical tree with children of sizes `l` and `r` is
balanced: either `l ≤ δ * r` and `r ≤ δ * r`, or the tree is trivial with a singleton on one side
and nothing on the other. -/
def balanced_sz (l : ℕ) (r : ℕ) :=
  l + r ≤ 1 ∨ l ≤ delta * r ∧ r ≤ delta * l

protected instance balanced_sz.dec : DecidableRel balanced_sz :=
  fun (l r : ℕ) => or.decidable

/-- The `balanced t` asserts that the tree `t` satisfies the balance invariants
(at every level). -/
def balanced {α : Type u_1} : ordnode α → Prop :=
  sorry

protected instance balanced.dec {α : Type u_1} : decidable_pred balanced :=
  sorry

theorem balanced_sz.symm {l : ℕ} {r : ℕ} : balanced_sz l r → balanced_sz r l :=
  or.imp (eq.mpr (id (Eq._oldrec (Eq.refl (l + r ≤ 1 → r + l ≤ 1)) (add_comm l r))) id) and.symm

theorem balanced_sz_zero {l : ℕ} : balanced_sz l 0 ↔ l ≤ 1 := sorry

theorem balanced_sz_up {l : ℕ} {r₁ : ℕ} {r₂ : ℕ} (h₁ : r₁ ≤ r₂) (h₂ : l + r₂ ≤ 1 ∨ r₂ ≤ delta * l) (H : balanced_sz l r₁) : balanced_sz l r₂ := sorry

theorem balanced_sz_down {l : ℕ} {r₁ : ℕ} {r₂ : ℕ} (h₁ : r₁ ≤ r₂) (h₂ : l + r₂ ≤ 1 ∨ l ≤ delta * r₁) (H : balanced_sz l r₂) : balanced_sz l r₁ := sorry

theorem balanced.dual {α : Type u_1} {t : ordnode α} : balanced t → balanced (dual t) := sorry

/-! ### `rotate` and `balance` -/

/-- Build a tree from three nodes, left associated (ignores the invariants). -/
def node3_l {α : Type u_1} (l : ordnode α) (x : α) (m : ordnode α) (y : α) (r : ordnode α) : ordnode α :=
  node' (node' l x m) y r

/-- Build a tree from three nodes, right associated (ignores the invariants). -/
def node3_r {α : Type u_1} (l : ordnode α) (x : α) (m : ordnode α) (y : α) (r : ordnode α) : ordnode α :=
  node' l x (node' m y r)

/-- Build a tree from three nodes, with `a () b -> (a ()) b` and `a (b c) d -> ((a b) (c d))`. -/
def node4_l {α : Type u_1} : ordnode α → α → ordnode α → α → ordnode α → ordnode α :=
  sorry

/-- Build a tree from three nodes, with `a () b -> a (() b)` and `a (b c) d -> ((a b) (c d))`. -/
def node4_r {α : Type u_1} : ordnode α → α → ordnode α → α → ordnode α → ordnode α :=
  sorry

/-- Concatenate two nodes, performing a left rotation `x (y z) -> ((x y) z)`
if balance is upset. -/
def rotate_l {α : Type u_1} : ordnode α → α → ordnode α → ordnode α :=
  sorry

/-- Concatenate two nodes, performing a right rotation `(x y) z -> (x (y z))`
if balance is upset. -/
def rotate_r {α : Type u_1} : ordnode α → α → ordnode α → ordnode α :=
  sorry

/-- A left balance operation. This will rebalance a concatenation, assuming the original nodes are
not too far from balanced. -/
def balance_l' {α : Type u_1} (l : ordnode α) (x : α) (r : ordnode α) : ordnode α :=
  ite (size l + size r ≤ 1) (node' l x r) (ite (size l > delta * size r) (rotate_r l x r) (node' l x r))

/-- A right balance operation. This will rebalance a concatenation, assuming the original nodes are
not too far from balanced. -/
def balance_r' {α : Type u_1} (l : ordnode α) (x : α) (r : ordnode α) : ordnode α :=
  ite (size l + size r ≤ 1) (node' l x r) (ite (size r > delta * size l) (rotate_l l x r) (node' l x r))

/-- The full balance operation. This is the same as `balance`, but with less manual inlining.
It is somewhat easier to work with this version in proofs. -/
def balance' {α : Type u_1} (l : ordnode α) (x : α) (r : ordnode α) : ordnode α :=
  ite (size l + size r ≤ 1) (node' l x r)
    (ite (size r > delta * size l) (rotate_l l x r) (ite (size l > delta * size r) (rotate_r l x r) (node' l x r)))

theorem dual_node' {α : Type u_1} (l : ordnode α) (x : α) (r : ordnode α) : dual (node' l x r) = node' (dual r) x (dual l) := sorry

theorem dual_node3_l {α : Type u_1} (l : ordnode α) (x : α) (m : ordnode α) (y : α) (r : ordnode α) : dual (node3_l l x m y r) = node3_r (dual r) y (dual m) x (dual l) := sorry

theorem dual_node3_r {α : Type u_1} (l : ordnode α) (x : α) (m : ordnode α) (y : α) (r : ordnode α) : dual (node3_r l x m y r) = node3_l (dual r) y (dual m) x (dual l) := sorry

theorem dual_node4_l {α : Type u_1} (l : ordnode α) (x : α) (m : ordnode α) (y : α) (r : ordnode α) : dual (node4_l l x m y r) = node4_r (dual r) y (dual m) x (dual l) := sorry

theorem dual_node4_r {α : Type u_1} (l : ordnode α) (x : α) (m : ordnode α) (y : α) (r : ordnode α) : dual (node4_r l x m y r) = node4_l (dual r) y (dual m) x (dual l) := sorry

theorem dual_rotate_l {α : Type u_1} (l : ordnode α) (x : α) (r : ordnode α) : dual (rotate_l l x r) = rotate_r (dual r) x (dual l) := sorry

theorem dual_rotate_r {α : Type u_1} (l : ordnode α) (x : α) (r : ordnode α) : dual (rotate_r l x r) = rotate_l (dual r) x (dual l) := sorry

theorem dual_balance' {α : Type u_1} (l : ordnode α) (x : α) (r : ordnode α) : dual (balance' l x r) = balance' (dual r) x (dual l) := sorry

theorem dual_balance_l {α : Type u_1} (l : ordnode α) (x : α) (r : ordnode α) : dual (balance_l l x r) = balance_r (dual r) x (dual l) := sorry

theorem dual_balance_r {α : Type u_1} (l : ordnode α) (x : α) (r : ordnode α) : dual (balance_r l x r) = balance_l (dual r) x (dual l) := sorry

theorem sized.node3_l {α : Type u_1} {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} (hl : sized l) (hm : sized m) (hr : sized r) : sized (node3_l l x m y r) :=
  sized.node' (sized.node' hl hm) hr

theorem sized.node3_r {α : Type u_1} {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} (hl : sized l) (hm : sized m) (hr : sized r) : sized (node3_r l x m y r) :=
  sized.node' hl (sized.node' hm hr)

theorem sized.node4_l {α : Type u_1} {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} (hl : sized l) (hm : sized m) (hr : sized r) : sized (node4_l l x m y r) := sorry

theorem node3_l_size {α : Type u_1} {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} : size (node3_l l x m y r) = size l + size m + size r + bit0 1 := sorry

theorem node3_r_size {α : Type u_1} {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} : size (node3_r l x m y r) = size l + size m + size r + bit0 1 := sorry

theorem node4_l_size {α : Type u_1} {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} (hm : sized m) : size (node4_l l x m y r) = size l + size m + size r + bit0 1 := sorry

theorem sized.dual {α : Type u_1} {t : ordnode α} (h : sized t) : sized (dual t) := sorry

theorem sized.dual_iff {α : Type u_1} {t : ordnode α} : sized (dual t) ↔ sized t :=
  { mp := fun (h : sized (dual t)) => eq.mpr (id (Eq._oldrec (Eq.refl (sized t)) (Eq.symm (dual_dual t)))) (sized.dual h),
    mpr := sized.dual }

theorem sized.rotate_l {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (hl : sized l) (hr : sized r) : sized (rotate_l l x r) := sorry

theorem sized.rotate_r {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (hl : sized l) (hr : sized r) : sized (rotate_r l x r) :=
  iff.mp sized.dual_iff
    (eq.mpr (id (Eq._oldrec (Eq.refl (sized (dual (rotate_r l x r)))) (dual_rotate_r l x r)))
      (sized.rotate_l (sized.dual hr) (sized.dual hl)))

theorem sized.rotate_l_size {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (hm : sized r) : size (rotate_l l x r) = size l + size r + 1 := sorry

theorem sized.rotate_r_size {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (hl : sized l) : size (rotate_r l x r) = size l + size r + 1 := sorry

theorem sized.balance' {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (hl : sized l) (hr : sized r) : sized (balance' l x r) := sorry

theorem size_balance' {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (hl : sized l) (hr : sized r) : size (balance' l x r) = size l + size r + 1 := sorry

/-! ## `all`, `any`, `emem`, `amem` -/

theorem all.imp {α : Type u_1} {P : α → Prop} {Q : α → Prop} (H : ∀ (a : α), P a → Q a) {t : ordnode α} : all P t → all Q t := sorry

theorem any.imp {α : Type u_1} {P : α → Prop} {Q : α → Prop} (H : ∀ (a : α), P a → Q a) {t : ordnode α} : any P t → any Q t := sorry

theorem all_singleton {α : Type u_1} {P : α → Prop} {x : α} : all P (singleton x) ↔ P x :=
  { mp := fun (h : all P (singleton x)) => and.left (and.right h),
    mpr := fun (h : P x) => { left := True.intro, right := { left := h, right := True.intro } } }

theorem any_singleton {α : Type u_1} {P : α → Prop} {x : α} : any P (singleton x) ↔ P x := sorry

theorem all_dual {α : Type u_1} {P : α → Prop} {t : ordnode α} : all P (dual t) ↔ all P t := sorry

theorem all_iff_forall {α : Type u_1} {P : α → Prop} {t : ordnode α} : all P t ↔ ∀ (x : α), emem x t → P x := sorry

theorem any_iff_exists {α : Type u_1} {P : α → Prop} {t : ordnode α} : any P t ↔ ∃ (x : α), emem x t ∧ P x := sorry

theorem emem_iff_all {α : Type u_1} {x : α} {t : ordnode α} : emem x t ↔ ∀ (P : α → Prop), all P t → P x := sorry

theorem all_node' {α : Type u_1} {P : α → Prop} {l : ordnode α} {x : α} {r : ordnode α} : all P (node' l x r) ↔ all P l ∧ P x ∧ all P r :=
  iff.rfl

theorem all_node3_l {α : Type u_1} {P : α → Prop} {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} : all P (node3_l l x m y r) ↔ all P l ∧ P x ∧ all P m ∧ P y ∧ all P r := sorry

theorem all_node3_r {α : Type u_1} {P : α → Prop} {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} : all P (node3_r l x m y r) ↔ all P l ∧ P x ∧ all P m ∧ P y ∧ all P r :=
  iff.rfl

theorem all_node4_l {α : Type u_1} {P : α → Prop} {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} : all P (node4_l l x m y r) ↔ all P l ∧ P x ∧ all P m ∧ P y ∧ all P r := sorry

theorem all_node4_r {α : Type u_1} {P : α → Prop} {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} : all P (node4_r l x m y r) ↔ all P l ∧ P x ∧ all P m ∧ P y ∧ all P r := sorry

theorem all_rotate_l {α : Type u_1} {P : α → Prop} {l : ordnode α} {x : α} {r : ordnode α} : all P (rotate_l l x r) ↔ all P l ∧ P x ∧ all P r := sorry

theorem all_rotate_r {α : Type u_1} {P : α → Prop} {l : ordnode α} {x : α} {r : ordnode α} : all P (rotate_r l x r) ↔ all P l ∧ P x ∧ all P r := sorry

theorem all_balance' {α : Type u_1} {P : α → Prop} {l : ordnode α} {x : α} {r : ordnode α} : all P (balance' l x r) ↔ all P l ∧ P x ∧ all P r := sorry

/-! ### `to_list` -/

theorem foldr_cons_eq_to_list {α : Type u_1} (t : ordnode α) (r : List α) : foldr List.cons t r = to_list t ++ r := sorry

@[simp] theorem to_list_nil {α : Type u_1} : to_list nil = [] :=
  rfl

@[simp] theorem to_list_node {α : Type u_1} (s : ℕ) (l : ordnode α) (x : α) (r : ordnode α) : to_list (node s l x r) = to_list l ++ x :: to_list r := sorry

theorem emem_iff_mem_to_list {α : Type u_1} {x : α} {t : ordnode α} : emem x t ↔ x ∈ to_list t := sorry

theorem length_to_list' {α : Type u_1} (t : ordnode α) : list.length (to_list t) = real_size t := sorry

theorem length_to_list {α : Type u_1} {t : ordnode α} (h : sized t) : list.length (to_list t) = size t :=
  eq.mpr (id (Eq._oldrec (Eq.refl (list.length (to_list t) = size t)) (length_to_list' t)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (real_size t = size t)) (size_eq_real_size h))) (Eq.refl (real_size t)))

theorem equiv_iff {α : Type u_1} {t₁ : ordnode α} {t₂ : ordnode α} (h₁ : sized t₁) (h₂ : sized t₂) : equiv t₁ t₂ ↔ to_list t₁ = to_list t₂ := sorry

/-! ### `(find/erase/split)_(min/max)` -/

theorem find_min'_dual {α : Type u_1} (t : ordnode α) (x : α) : find_min' (dual t) x = find_max' x t := sorry

theorem find_max'_dual {α : Type u_1} (t : ordnode α) (x : α) : find_max' x (dual t) = find_min' t x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (find_max' x (dual t) = find_min' t x)) (Eq.symm (find_min'_dual (dual t) x))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (find_min' (dual (dual t)) x = find_min' t x)) (dual_dual t)))
      (Eq.refl (find_min' t x)))

theorem find_min_dual {α : Type u_1} (t : ordnode α) : find_min (dual t) = find_max t :=
  ordnode.cases_on t (idRhs (find_min (dual nil) = find_min (dual nil)) rfl)
    fun (t_size : ℕ) (t_l : ordnode α) (t_x : α) (t_r : ordnode α) =>
      idRhs (some (find_min' (dual t_r) t_x) = some (find_max' t_x t_r)) (congr_arg some (find_min'_dual t_r t_x))

theorem find_max_dual {α : Type u_1} (t : ordnode α) : find_max (dual t) = find_min t :=
  eq.mpr (id (Eq._oldrec (Eq.refl (find_max (dual t) = find_min t)) (Eq.symm (find_min_dual (dual t)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (find_min (dual (dual t)) = find_min t)) (dual_dual t))) (Eq.refl (find_min t)))

theorem dual_erase_min {α : Type u_1} (t : ordnode α) : dual (erase_min t) = erase_max (dual t) := sorry

theorem dual_erase_max {α : Type u_1} (t : ordnode α) : dual (erase_max t) = erase_min (dual t) := sorry

theorem split_min_eq {α : Type u_1} (s : ℕ) (l : ordnode α) (x : α) (r : ordnode α) : split_min' l x r = (find_min' l x, erase_min (node s l x r)) := sorry

theorem split_max_eq {α : Type u_1} (s : ℕ) (l : ordnode α) (x : α) (r : ordnode α) : split_max' l x r = (erase_max (node s l x r), find_max' x r) := sorry

theorem find_min'_all {α : Type u_1} {P : α → Prop} (t : ordnode α) (x : α) : all P t → P x → P (find_min' t x) := sorry

theorem find_max'_all {α : Type u_1} {P : α → Prop} (x : α) (t : ordnode α) : P x → all P t → P (find_max' x t) := sorry

/-! ### `glue` -/

/-! ### `merge` -/

@[simp] theorem merge_nil_left {α : Type u_1} (t : ordnode α) : merge t nil = t :=
  ordnode.cases_on t (Eq.refl (merge nil nil))
    fun (t_size : ℕ) (t_l : ordnode α) (t_x : α) (t_r : ordnode α) => Eq.refl (merge (node t_size t_l t_x t_r) nil)

@[simp] theorem merge_nil_right {α : Type u_1} (t : ordnode α) : merge nil t = t :=
  rfl

@[simp] theorem merge_node {α : Type u_1} {ls : ℕ} {ll : ordnode α} {lx : α} {lr : ordnode α} {rs : ℕ} {rl : ordnode α} {rx : α} {rr : ordnode α} : merge (node ls ll lx lr) (node rs rl rx rr) =
  ite (delta * ls < rs) (balance_l (merge (node ls ll lx lr) rl) rx rr)
    (ite (delta * rs < ls) (balance_r ll lx (merge lr (node rs rl rx rr))) (glue (node ls ll lx lr) (node rs rl rx rr))) :=
  rfl

/-! ### `insert` -/

theorem dual_insert {α : Type u_1} [preorder α] [is_total α LessEq] [DecidableRel LessEq] (x : α) (t : ordnode α) : dual (ordnode.insert x t) = ordnode.insert x (dual t) := sorry

/-! ### `balance` properties -/

theorem balance_eq_balance' {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (hl : balanced l) (hr : balanced r) (sl : sized l) (sr : sized r) : balance l x r = balance' l x r := sorry

theorem balance_l_eq_balance {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (sl : sized l) (sr : sized r) (H1 : size l = 0 → size r ≤ 1) (H2 : 1 ≤ size l → 1 ≤ size r → size r ≤ delta * size l) : balance_l l x r = balance l x r := sorry

/-- `raised n m` means `m` is either equal or one up from `n`. -/
def raised (n : ℕ) (m : ℕ) :=
  m = n ∨ m = n + 1

theorem raised_iff {n : ℕ} {m : ℕ} : raised n m ↔ n ≤ m ∧ m ≤ n + 1 := sorry

theorem raised.dist_le {n : ℕ} {m : ℕ} (H : raised n m) : nat.dist n m ≤ 1 := sorry

theorem raised.dist_le' {n : ℕ} {m : ℕ} (H : raised n m) : nat.dist m n ≤ 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nat.dist m n ≤ 1)) (nat.dist_comm m n))) (raised.dist_le H)

theorem raised.add_left (k : ℕ) {n : ℕ} {m : ℕ} (H : raised n m) : raised (k + n) (k + m) :=
  or.dcases_on H (fun (H : m = n) => Eq._oldrec (Or.inl rfl) H) fun (H : m = n + 1) => Eq._oldrec (Or.inr rfl) (Eq.symm H)

theorem raised.add_right (k : ℕ) {n : ℕ} {m : ℕ} (H : raised n m) : raised (n + k) (m + k) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (raised (n + k) (m + k))) (add_comm n k)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (raised (k + n) (m + k))) (add_comm m k))) (raised.add_left k H))

theorem raised.right {α : Type u_1} {l : ordnode α} {x₁ : α} {x₂ : α} {r₁ : ordnode α} {r₂ : ordnode α} (H : raised (size r₁) (size r₂)) : raised (size (node' l x₁ r₁)) (size (node' l x₂ r₂)) := sorry

theorem balance_l_eq_balance' {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (hl : balanced l) (hr : balanced r) (sl : sized l) (sr : sized r) (H : (∃ (l' : ℕ), raised l' (size l) ∧ balanced_sz l' (size r)) ∨ ∃ (r' : ℕ), raised (size r) r' ∧ balanced_sz (size l) r') : balance_l l x r = balance' l x r := sorry

theorem balance_sz_dual {α : Type u_1} {l : ordnode α} {r : ordnode α} (H : (∃ (l' : ℕ), raised (size l) l' ∧ balanced_sz l' (size r)) ∨ ∃ (r' : ℕ), raised r' (size r) ∧ balanced_sz (size l) r') : (∃ (l' : ℕ), raised l' (size (dual r)) ∧ balanced_sz l' (size (dual l))) ∨
  ∃ (r' : ℕ), raised (size (dual l)) r' ∧ balanced_sz (size (dual r)) r' := sorry

theorem size_balance_l {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (hl : balanced l) (hr : balanced r) (sl : sized l) (sr : sized r) (H : (∃ (l' : ℕ), raised l' (size l) ∧ balanced_sz l' (size r)) ∨ ∃ (r' : ℕ), raised (size r) r' ∧ balanced_sz (size l) r') : size (balance_l l x r) = size l + size r + 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (size (balance_l l x r) = size l + size r + 1)) (balance_l_eq_balance' hl hr sl sr H)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (size (balance' l x r) = size l + size r + 1)) (size_balance' sl sr)))
      (Eq.refl (size l + size r + 1)))

theorem all_balance_l {α : Type u_1} {P : α → Prop} {l : ordnode α} {x : α} {r : ordnode α} (hl : balanced l) (hr : balanced r) (sl : sized l) (sr : sized r) (H : (∃ (l' : ℕ), raised l' (size l) ∧ balanced_sz l' (size r)) ∨ ∃ (r' : ℕ), raised (size r) r' ∧ balanced_sz (size l) r') : all P (balance_l l x r) ↔ all P l ∧ P x ∧ all P r := sorry

theorem balance_r_eq_balance' {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (hl : balanced l) (hr : balanced r) (sl : sized l) (sr : sized r) (H : (∃ (l' : ℕ), raised (size l) l' ∧ balanced_sz l' (size r)) ∨ ∃ (r' : ℕ), raised r' (size r) ∧ balanced_sz (size l) r') : balance_r l x r = balance' l x r := sorry

theorem size_balance_r {α : Type u_1} {l : ordnode α} {x : α} {r : ordnode α} (hl : balanced l) (hr : balanced r) (sl : sized l) (sr : sized r) (H : (∃ (l' : ℕ), raised (size l) l' ∧ balanced_sz l' (size r)) ∨ ∃ (r' : ℕ), raised r' (size r) ∧ balanced_sz (size l) r') : size (balance_r l x r) = size l + size r + 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (size (balance_r l x r) = size l + size r + 1)) (balance_r_eq_balance' hl hr sl sr H)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (size (balance' l x r) = size l + size r + 1)) (size_balance' sl sr)))
      (Eq.refl (size l + size r + 1)))

theorem all_balance_r {α : Type u_1} {P : α → Prop} {l : ordnode α} {x : α} {r : ordnode α} (hl : balanced l) (hr : balanced r) (sl : sized l) (sr : sized r) (H : (∃ (l' : ℕ), raised (size l) l' ∧ balanced_sz l' (size r)) ∨ ∃ (r' : ℕ), raised r' (size r) ∧ balanced_sz (size l) r') : all P (balance_r l x r) ↔ all P l ∧ P x ∧ all P r := sorry

/-! ### `bounded` -/

/-- `bounded t lo hi` says that every element `x ∈ t` is in the range `lo < x < hi`, and also this
property holds recursively in subtrees, making the full tree a BST. The bounds can be set to
`lo = ⊥` and `hi = ⊤` if we care only about the internal ordering constraints. -/
def bounded {α : Type u_1} [preorder α] : ordnode α → with_bot α → with_top α → Prop :=
  sorry

theorem bounded.dual {α : Type u_1} [preorder α] {t : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (h : bounded t o₁ o₂) : bounded (dual t) o₂ o₁ := sorry

theorem bounded.dual_iff {α : Type u_1} [preorder α] {t : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} : bounded t o₁ o₂ ↔ bounded (dual t) o₂ o₁ := sorry

theorem bounded.weak_left {α : Type u_1} [preorder α] {t : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} : bounded t o₁ o₂ → bounded t ⊥ o₂ := sorry

theorem bounded.weak_right {α : Type u_1} [preorder α] {t : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} : bounded t o₁ o₂ → bounded t o₁ ⊤ := sorry

theorem bounded.weak {α : Type u_1} [preorder α] {t : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (h : bounded t o₁ o₂) : bounded t ⊥ ⊤ :=
  bounded.weak_right (bounded.weak_left h)

theorem bounded.mono_left {α : Type u_1} [preorder α] {x : α} {y : α} (xy : x ≤ y) {t : ordnode α} {o : with_top α} : bounded t (↑y) o → bounded t (↑x) o := sorry

theorem bounded.mono_right {α : Type u_1} [preorder α] {x : α} {y : α} (xy : x ≤ y) {t : ordnode α} {o : with_bot α} : bounded t o ↑x → bounded t o ↑y := sorry

theorem bounded.to_lt {α : Type u_1} [preorder α] {t : ordnode α} {x : α} {y : α} : bounded t ↑x ↑y → x < y := sorry

theorem bounded.to_nil {α : Type u_1} [preorder α] {t : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} : bounded t o₁ o₂ → bounded nil o₁ o₂ := sorry

theorem bounded.trans_left {α : Type u_1} [preorder α] {t₁ : ordnode α} {t₂ : ordnode α} {x : α} {o₁ : with_bot α} {o₂ : with_top α} : bounded t₁ o₁ ↑x → bounded t₂ (↑x) o₂ → bounded t₂ o₁ o₂ := sorry

theorem bounded.trans_right {α : Type u_1} [preorder α] {t₁ : ordnode α} {t₂ : ordnode α} {x : α} {o₁ : with_bot α} {o₂ : with_top α} : bounded t₁ o₁ ↑x → bounded t₂ (↑x) o₂ → bounded t₁ o₁ o₂ := sorry

theorem bounded.mem_lt {α : Type u_1} [preorder α] {t : ordnode α} {o : with_bot α} {x : α} : bounded t o ↑x → all (fun (_x : α) => _x < x) t := sorry

theorem bounded.mem_gt {α : Type u_1} [preorder α] {t : ordnode α} {o : with_top α} {x : α} : bounded t (↑x) o → all (fun (_x : α) => _x > x) t := sorry

theorem bounded.of_lt {α : Type u_1} [preorder α] {t : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} {x : α} : bounded t o₁ o₂ → bounded nil o₁ ↑x → all (fun (_x : α) => _x < x) t → bounded t o₁ ↑x := sorry

theorem bounded.of_gt {α : Type u_1} [preorder α] {t : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} {x : α} : bounded t o₁ o₂ → bounded nil (↑x) o₂ → all (fun (_x : α) => _x > x) t → bounded t (↑x) o₂ := sorry

theorem bounded.to_sep {α : Type u_1} [preorder α] {t₁ : ordnode α} {t₂ : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} {x : α} (h₁ : bounded t₁ o₁ ↑x) (h₂ : bounded t₂ (↑x) o₂) : all (fun (y : α) => all (fun (z : α) => y < z) t₂) t₁ :=
  all.imp (fun (y : α) (yx : y < x) => all.imp (fun (z : α) (xz : z > x) => lt_trans yx xz) (bounded.mem_gt h₂))
    (bounded.mem_lt h₁)

/-! ### `valid` -/

/-- The validity predicate for an `ordnode` subtree. This asserts that the `size` fields are
correct, the tree is balanced, and the elements of the tree are organized according to the
ordering. This version of `valid` also puts all elements in the tree in the interval `(lo, hi)`. -/
structure valid' {α : Type u_1} [preorder α] (lo : with_bot α) (t : ordnode α) (hi : with_top α)
where
  ord : bounded t lo hi
  sz : sized t
  bal : balanced t

/-- The validity predicate for an `ordnode` subtree. This asserts that the `size` fields are
correct, the tree is balanced, and the elements of the tree are organized according to the
ordering. -/
def valid {α : Type u_1} [preorder α] (t : ordnode α) :=
  valid' ⊥ t ⊤

theorem valid'.mono_left {α : Type u_1} [preorder α] {x : α} {y : α} (xy : x ≤ y) {t : ordnode α} {o : with_top α} (h : valid' (↑y) t o) : valid' (↑x) t o :=
  valid'.mk (bounded.mono_left xy (valid'.ord h)) (valid'.sz h) (valid'.bal h)

theorem valid'.mono_right {α : Type u_1} [preorder α] {x : α} {y : α} (xy : x ≤ y) {t : ordnode α} {o : with_bot α} (h : valid' o t ↑x) : valid' o t ↑y :=
  valid'.mk (bounded.mono_right xy (valid'.ord h)) (valid'.sz h) (valid'.bal h)

theorem valid'.trans_left {α : Type u_1} [preorder α] {t₁ : ordnode α} {t₂ : ordnode α} {x : α} {o₁ : with_bot α} {o₂ : with_top α} (h : bounded t₁ o₁ ↑x) (H : valid' (↑x) t₂ o₂) : valid' o₁ t₂ o₂ :=
  valid'.mk (bounded.trans_left h (valid'.ord H)) (valid'.sz H) (valid'.bal H)

theorem valid'.trans_right {α : Type u_1} [preorder α] {t₁ : ordnode α} {t₂ : ordnode α} {x : α} {o₁ : with_bot α} {o₂ : with_top α} (H : valid' o₁ t₁ ↑x) (h : bounded t₂ (↑x) o₂) : valid' o₁ t₁ o₂ :=
  valid'.mk (bounded.trans_right (valid'.ord H) h) (valid'.sz H) (valid'.bal H)

theorem valid'.of_lt {α : Type u_1} [preorder α] {t : ordnode α} {x : α} {o₁ : with_bot α} {o₂ : with_top α} (H : valid' o₁ t o₂) (h₁ : bounded nil o₁ ↑x) (h₂ : all (fun (_x : α) => _x < x) t) : valid' o₁ t ↑x :=
  valid'.mk (bounded.of_lt (valid'.ord H) h₁ h₂) (valid'.sz H) (valid'.bal H)

theorem valid'.of_gt {α : Type u_1} [preorder α] {t : ordnode α} {x : α} {o₁ : with_bot α} {o₂ : with_top α} (H : valid' o₁ t o₂) (h₁ : bounded nil (↑x) o₂) (h₂ : all (fun (_x : α) => _x > x) t) : valid' (↑x) t o₂ :=
  valid'.mk (bounded.of_gt (valid'.ord H) h₁ h₂) (valid'.sz H) (valid'.bal H)

theorem valid'.valid {α : Type u_1} [preorder α] {t : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (h : valid' o₁ t o₂) : valid t :=
  valid'.mk (bounded.weak (valid'.ord h)) (valid'.sz h) (valid'.bal h)

theorem valid'_nil {α : Type u_1} [preorder α] {o₁ : with_bot α} {o₂ : with_top α} (h : bounded nil o₁ o₂) : valid' o₁ nil o₂ :=
  valid'.mk h True.intro True.intro

theorem valid_nil {α : Type u_1} [preorder α] : valid nil :=
  valid'_nil True.intro

theorem valid'.node {α : Type u_1} [preorder α] {s : ℕ} {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hr : valid' (↑x) r o₂) (H : balanced_sz (size l) (size r)) (hs : s = size l + size r + 1) : valid' o₁ (node s l x r) o₂ :=
  valid'.mk { left := valid'.ord hl, right := valid'.ord hr }
    { left := hs, right := { left := valid'.sz hl, right := valid'.sz hr } }
    { left := H, right := { left := valid'.bal hl, right := valid'.bal hr } }

theorem valid'.dual {α : Type u_1} [preorder α] {t : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (h : valid' o₁ t o₂) : valid' o₂ (dual t) o₁ := sorry

theorem valid'.dual_iff {α : Type u_1} [preorder α] {t : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} : valid' o₁ t o₂ ↔ valid' o₂ (dual t) o₁ := sorry

theorem valid.dual {α : Type u_1} [preorder α] {t : ordnode α} : valid t → valid (dual t) :=
  valid'.dual

theorem valid.dual_iff {α : Type u_1} [preorder α] {t : ordnode α} : valid t ↔ valid (dual t) :=
  valid'.dual_iff

theorem valid'.left {α : Type u_1} [preorder α] {s : ℕ} {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (H : valid' o₁ (node s l x r) o₂) : valid' o₁ l ↑x :=
  valid'.mk (and.left (valid'.ord H)) (and.left (and.right (valid'.sz H))) (and.left (and.right (valid'.bal H)))

theorem valid'.right {α : Type u_1} [preorder α] {s : ℕ} {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (H : valid' o₁ (node s l x r) o₂) : valid' (↑x) r o₂ :=
  valid'.mk (and.right (valid'.ord H)) (and.right (and.right (valid'.sz H))) (and.right (and.right (valid'.bal H)))

theorem valid.left {α : Type u_1} [preorder α] {s : ℕ} {l : ordnode α} {x : α} {r : ordnode α} (H : valid (node s l x r)) : valid l :=
  valid'.valid (valid'.left H)

theorem valid.right {α : Type u_1} [preorder α] {s : ℕ} {l : ordnode α} {x : α} {r : ordnode α} (H : valid (node s l x r)) : valid r :=
  valid'.valid (valid'.right H)

theorem valid.size_eq {α : Type u_1} [preorder α] {s : ℕ} {l : ordnode α} {x : α} {r : ordnode α} (H : valid (node s l x r)) : size (node s l x r) = size l + size r + 1 :=
  and.left (valid'.sz H)

theorem valid'.node' {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hr : valid' (↑x) r o₂) (H : balanced_sz (size l) (size r)) : valid' o₁ (node' l x r) o₂ :=
  valid'.node hl hr H rfl

theorem valid'_singleton {α : Type u_1} [preorder α] {x : α} {o₁ : with_bot α} {o₂ : with_top α} (h₁ : bounded nil o₁ ↑x) (h₂ : bounded nil (↑x) o₂) : valid' o₁ (singleton x) o₂ :=
  valid'.node (valid'_nil h₁) (valid'_nil h₂) (Or.inl zero_le_one) rfl

theorem valid_singleton {α : Type u_1} [preorder α] {x : α} : valid (singleton x) :=
  valid'_singleton True.intro True.intro

theorem valid'.node3_l {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hm : valid' (↑x) m ↑y) (hr : valid' (↑y) r o₂) (H1 : balanced_sz (size l) (size m)) (H2 : balanced_sz (size l + size m + 1) (size r)) : valid' o₁ (node3_l l x m y r) o₂ :=
  valid'.node' (valid'.node' hl hm H1) hr H2

theorem valid'.node3_r {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hm : valid' (↑x) m ↑y) (hr : valid' (↑y) r o₂) (H1 : balanced_sz (size l) (size m + size r + 1)) (H2 : balanced_sz (size m) (size r)) : valid' o₁ (node3_r l x m y r) o₂ :=
  valid'.node' hl (valid'.node' hm hr H2) H1

theorem valid'.node4_l_lemma₁ {a : ℕ} {b : ℕ} {c : ℕ} {d : ℕ} (lr₂ : bit1 1 * (b + c + 1 + d) ≤ bit0 (bit0 (bit0 (bit0 1))) * a + bit1 (bit0 (bit0 1))) (mr₂ : b + c + 1 ≤ bit1 1 * d) (mm₁ : b ≤ bit1 1 * c) : b < bit1 1 * a + 1 := sorry

theorem valid'.node4_l_lemma₂ {b : ℕ} {c : ℕ} {d : ℕ} (mr₂ : b + c + 1 ≤ bit1 1 * d) : c ≤ bit1 1 * d := sorry

theorem valid'.node4_l_lemma₃ {b : ℕ} {c : ℕ} {d : ℕ} (mr₁ : bit0 1 * d ≤ b + c + 1) (mm₁ : b ≤ bit1 1 * c) : d ≤ bit1 1 * c := sorry

theorem valid'.node4_l_lemma₄ {a : ℕ} {b : ℕ} {c : ℕ} {d : ℕ} (lr₁ : bit1 1 * a ≤ b + c + 1 + d) (mr₂ : b + c + 1 ≤ bit1 1 * d) (mm₁ : b ≤ bit1 1 * c) : a + b + 1 ≤ bit1 1 * (c + d + 1) := sorry

theorem valid'.node4_l_lemma₅ {a : ℕ} {b : ℕ} {c : ℕ} {d : ℕ} (lr₂ : bit1 1 * (b + c + 1 + d) ≤ bit0 (bit0 (bit0 (bit0 1))) * a + bit1 (bit0 (bit0 1))) (mr₁ : bit0 1 * d ≤ b + c + 1) (mm₂ : c ≤ bit1 1 * b) : c + d + 1 ≤ bit1 1 * (a + b + 1) := sorry

theorem valid'.node4_l {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {m : ordnode α} {y : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hm : valid' (↑x) m ↑y) (hr : valid' (↑y) r o₂) (Hm : 0 < size m) (H : size l = 0 ∧ size m = 1 ∧ size r ≤ 1 ∨
  0 < size l ∧
    ratio * size r ≤ size m ∧
      delta * size l ≤ size m + size r ∧
        bit1 1 * (size m + size r) ≤ bit0 (bit0 (bit0 (bit0 1))) * size l + bit1 (bit0 (bit0 1)) ∧
          size m ≤ delta * size r) : valid' o₁ (node4_l l x m y r) o₂ := sorry

theorem valid'.rotate_l_lemma₁ {a : ℕ} {b : ℕ} {c : ℕ} (H2 : bit1 1 * a ≤ b + c) (hb₂ : c ≤ bit1 1 * b) : a ≤ bit1 1 * b := sorry

theorem valid'.rotate_l_lemma₂ {a : ℕ} {b : ℕ} {c : ℕ} (H3 : bit0 1 * (b + c) ≤ bit1 (bit0 (bit0 1)) * a + bit1 1) (h : b < bit0 1 * c) : b < bit1 1 * a + 1 := sorry

theorem valid'.rotate_l_lemma₃ {a : ℕ} {b : ℕ} {c : ℕ} (H2 : bit1 1 * a ≤ b + c) (h : b < bit0 1 * c) : a + b < bit1 1 * c := sorry

theorem valid'.rotate_l_lemma₄ {a : ℕ} {b : ℕ} (H3 : bit0 1 * b ≤ bit1 (bit0 (bit0 1)) * a + bit1 1) : bit1 1 * b ≤ bit0 (bit0 (bit0 (bit0 1))) * a + bit1 (bit0 (bit0 1)) := sorry

theorem valid'.rotate_l {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hr : valid' (↑x) r o₂) (H1 : ¬size l + size r ≤ 1) (H2 : delta * size l < size r) (H3 : bit0 1 * size r ≤ bit1 (bit0 (bit0 1)) * size l + bit1 (bit0 1) ∨ size r ≤ bit1 1) : valid' o₁ (rotate_l l x r) o₂ := sorry

theorem valid'.rotate_r {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hr : valid' (↑x) r o₂) (H1 : ¬size l + size r ≤ 1) (H2 : delta * size r < size l) (H3 : bit0 1 * size l ≤ bit1 (bit0 (bit0 1)) * size r + bit1 (bit0 1) ∨ size l ≤ bit1 1) : valid' o₁ (rotate_r l x r) o₂ := sorry

theorem valid'.balance'_aux {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hr : valid' (↑x) r o₂) (H₁ : bit0 1 * size r ≤ bit1 (bit0 (bit0 1)) * size l + bit1 (bit0 1) ∨ size r ≤ bit1 1) (H₂ : bit0 1 * size l ≤ bit1 (bit0 (bit0 1)) * size r + bit1 (bit0 1) ∨ size l ≤ bit1 1) : valid' o₁ (balance' l x r) o₂ := sorry

theorem valid'.balance'_lemma {α : Type u_1} {l : ordnode α} {l' : ℕ} {r : ordnode α} {r' : ℕ} (H1 : balanced_sz l' r') (H2 : nat.dist (size l) l' ≤ 1 ∧ size r = r' ∨ nat.dist (size r) r' ≤ 1 ∧ size l = l') : bit0 1 * size r ≤ bit1 (bit0 (bit0 1)) * size l + bit1 (bit0 1) ∨ size r ≤ bit1 1 := sorry

theorem valid'.balance' {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hr : valid' (↑x) r o₂) (H : ∃ (l' : ℕ),
  ∃ (r' : ℕ), balanced_sz l' r' ∧ (nat.dist (size l) l' ≤ 1 ∧ size r = r' ∨ nat.dist (size r) r' ≤ 1 ∧ size l = l')) : valid' o₁ (balance' l x r) o₂ := sorry

theorem valid'.balance {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hr : valid' (↑x) r o₂) (H : ∃ (l' : ℕ),
  ∃ (r' : ℕ), balanced_sz l' r' ∧ (nat.dist (size l) l' ≤ 1 ∧ size r = r' ∨ nat.dist (size r) r' ≤ 1 ∧ size l = l')) : valid' o₁ (balance l x r) o₂ := sorry

theorem valid'.balance_l_aux {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hr : valid' (↑x) r o₂) (H₁ : size l = 0 → size r ≤ 1) (H₂ : 1 ≤ size l → 1 ≤ size r → size r ≤ delta * size l) (H₃ : bit0 1 * size l ≤ bit1 (bit0 (bit0 1)) * size r + bit1 (bit0 1) ∨ size l ≤ bit1 1) : valid' o₁ (balance_l l x r) o₂ := sorry

theorem valid'.balance_l {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hr : valid' (↑x) r o₂) (H : (∃ (l' : ℕ), raised l' (size l) ∧ balanced_sz l' (size r)) ∨ ∃ (r' : ℕ), raised (size r) r' ∧ balanced_sz (size l) r') : valid' o₁ (balance_l l x r) o₂ := sorry

theorem valid'.balance_r_aux {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hr : valid' (↑x) r o₂) (H₁ : size r = 0 → size l ≤ 1) (H₂ : 1 ≤ size r → 1 ≤ size l → size l ≤ delta * size r) (H₃ : bit0 1 * size r ≤ bit1 (bit0 (bit0 1)) * size l + bit1 (bit0 1) ∨ size r ≤ bit1 1) : valid' o₁ (balance_r l x r) o₂ := sorry

theorem valid'.balance_r {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hr : valid' (↑x) r o₂) (H : (∃ (l' : ℕ), raised (size l) l' ∧ balanced_sz l' (size r)) ∨ ∃ (r' : ℕ), raised r' (size r) ∧ balanced_sz (size l) r') : valid' o₁ (balance_r l x r) o₂ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (valid' o₁ (balance_r l x r) o₂)) (propext valid'.dual_iff)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (valid' o₂ (dual (balance_r l x r)) o₁)) (dual_balance_r l x r)))
      (valid'.balance_l (valid'.dual hr) (valid'.dual hl) (balance_sz_dual H)))

theorem valid'.erase_max_aux {α : Type u_1} [preorder α] {s : ℕ} {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (H : valid' o₁ (node s l x r) o₂) : valid' o₁ (erase_max (node' l x r)) ↑(find_max' x r) ∧ size (node' l x r) = size (erase_max (node' l x r)) + 1 := sorry

theorem valid'.erase_min_aux {α : Type u_1} [preorder α] {s : ℕ} {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (H : valid' o₁ (node s l x r) o₂) : valid' (↑(find_min' l x)) (erase_min (node' l x r)) o₂ ∧ size (node' l x r) = size (erase_min (node' l x r)) + 1 := sorry

theorem erase_min.valid {α : Type u_1} [preorder α] {t : ordnode α} (h : valid t) : valid (erase_min t) := sorry

theorem erase_max.valid {α : Type u_1} [preorder α] {t : ordnode α} (h : valid t) : valid (erase_max t) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (valid (erase_max t))) (propext valid.dual_iff)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (valid (dual (erase_max t)))) (dual_erase_max t))) (erase_min.valid (valid.dual h)))

theorem valid'.glue_aux {α : Type u_1} [preorder α] {l : ordnode α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l o₂) (hr : valid' o₁ r o₂) (sep : all (fun (x : α) => all (fun (y : α) => x < y) r) l) (bal : balanced_sz (size l) (size r)) : valid' o₁ (glue l r) o₂ ∧ size (glue l r) = size l + size r := sorry

theorem valid'.glue {α : Type u_1} [preorder α] {l : ordnode α} {x : α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l ↑x) (hr : valid' (↑x) r o₂) : balanced_sz (size l) (size r) → valid' o₁ (glue l r) o₂ ∧ size (glue l r) = size l + size r :=
  valid'.glue_aux (valid'.trans_right hl (valid'.ord hr)) (valid'.trans_left (valid'.ord hl) hr)
    (bounded.to_sep (valid'.ord hl) (valid'.ord hr))

theorem valid'.merge_lemma {a : ℕ} {b : ℕ} {c : ℕ} (h₁ : bit1 1 * a < b + c + 1) (h₂ : b ≤ bit1 1 * c) : bit0 1 * (a + b) ≤ bit1 (bit0 (bit0 1)) * c + bit1 (bit0 1) := sorry

theorem valid'.merge_aux₁ {α : Type u_1} [preorder α] {o₁ : with_bot α} {o₂ : with_top α} {ls : ℕ} {ll : ordnode α} {lx : α} {lr : ordnode α} {rs : ℕ} {rl : ordnode α} {rx : α} {rr : ordnode α} {t : ordnode α} (hl : valid' o₁ (node ls ll lx lr) o₂) (hr : valid' o₁ (node rs rl rx rr) o₂) (h : delta * ls < rs) (v : valid' o₁ t ↑rx) (e : size t = ls + size rl) : valid' o₁ (balance_l t rx rr) o₂ ∧ size (balance_l t rx rr) = ls + rs := sorry

theorem valid'.merge_aux {α : Type u_1} [preorder α] {l : ordnode α} {r : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} (hl : valid' o₁ l o₂) (hr : valid' o₁ r o₂) (sep : all (fun (x : α) => all (fun (y : α) => x < y) r) l) : valid' o₁ (merge l r) o₂ ∧ size (merge l r) = size l + size r := sorry

theorem valid.merge {α : Type u_1} [preorder α] {l : ordnode α} {r : ordnode α} (hl : valid l) (hr : valid r) (sep : all (fun (x : α) => all (fun (y : α) => x < y) r) l) : valid (merge l r) :=
  and.left (valid'.merge_aux hl hr sep)

theorem insert_with.valid_aux {α : Type u_1} [preorder α] [is_total α LessEq] [DecidableRel LessEq] (f : α → α) (x : α) (hf : ∀ (y : α), x ≤ y ∧ y ≤ x → x ≤ f y ∧ f y ≤ x) {t : ordnode α} {o₁ : with_bot α} {o₂ : with_top α} : valid' o₁ t o₂ →
  bounded nil o₁ ↑x →
    bounded nil (↑x) o₂ → valid' o₁ (insert_with f x t) o₂ ∧ raised (size t) (size (insert_with f x t)) := sorry

theorem insert_with.valid {α : Type u_1} [preorder α] [is_total α LessEq] [DecidableRel LessEq] (f : α → α) (x : α) (hf : ∀ (y : α), x ≤ y ∧ y ≤ x → x ≤ f y ∧ f y ≤ x) {t : ordnode α} (h : valid t) : valid (insert_with f x t) :=
  and.left (insert_with.valid_aux (fun (y : α) => f y) x hf h True.intro True.intro)

theorem insert_eq_insert_with {α : Type u_1} [preorder α] [DecidableRel LessEq] (x : α) (t : ordnode α) : ordnode.insert x t = insert_with (fun (_x : α) => x) x t := sorry

theorem insert.valid {α : Type u_1} [preorder α] [is_total α LessEq] [DecidableRel LessEq] (x : α) {t : ordnode α} (h : valid t) : valid (ordnode.insert x t) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (valid (ordnode.insert x t))) (insert_eq_insert_with x t)))
    (insert_with.valid (fun (_x : α) => x) x
      (fun (_x : α) (_x : x ≤ _x ∧ _x ≤ x) => { left := le_refl x, right := le_refl x }) h)

theorem insert'_eq_insert_with {α : Type u_1} [preorder α] [DecidableRel LessEq] (x : α) (t : ordnode α) : insert' x t = insert_with id x t := sorry

theorem insert'.valid {α : Type u_1} [preorder α] [is_total α LessEq] [DecidableRel LessEq] (x : α) {t : ordnode α} (h : valid t) : valid (insert' x t) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (valid (insert' x t))) (insert'_eq_insert_with x t)))
    (insert_with.valid id x (fun (_x : α) => id) h)

end ordnode

/-- An `ordset α` is a finite set of values, represented as a tree. The operations on this type
maintain that the tree is balanced and correctly stores subtree sizes at each level. The
correctness property of the tree is baked into the type, so all operations on this type are correct
by construction. -/
def ordset (α : Type u_1) [preorder α] :=
  Subtype fun (t : ordnode α) => ordnode.valid t

namespace ordset

/-- O(1). The empty set. -/
def nil {α : Type u_1} [preorder α] : ordset α :=
  { val := ordnode.nil, property := sorry }

/-- O(1). Get the size of the set. -/
def size {α : Type u_1} [preorder α] (s : ordset α) : ℕ :=
  ordnode.size (subtype.val s)

/-- O(1). Construct a singleton set containing value `a`. -/
protected def singleton {α : Type u_1} [preorder α] (a : α) : ordset α :=
  { val := singleton a, property := ordnode.valid_singleton }

protected instance has_emptyc {α : Type u_1} [preorder α] : has_emptyc (ordset α) :=
  has_emptyc.mk nil

protected instance inhabited {α : Type u_1} [preorder α] : Inhabited (ordset α) :=
  { default := nil }

protected instance has_singleton {α : Type u_1} [preorder α] : has_singleton α (ordset α) :=
  has_singleton.mk ordset.singleton

/-- O(1). Is the set empty? -/
def empty {α : Type u_1} [preorder α] (s : ordset α) :=
  s = ∅

theorem empty_iff {α : Type u_1} [preorder α] {s : ordset α} : s = ∅ ↔ ↥(ordnode.empty (subtype.val s)) := sorry

protected instance empty.decidable_pred {α : Type u_1} [preorder α] : decidable_pred empty :=
  fun (s : ordset α) => decidable_of_iff' (↥(ordnode.empty (subtype.val s))) empty_iff

/-- O(log n). Insert an element into the set, preserving balance and the BST property.
  If an equivalent element is already in the set, this replaces it. -/
protected def insert {α : Type u_1} [preorder α] [is_total α LessEq] [DecidableRel LessEq] (x : α) (s : ordset α) : ordset α :=
  { val := ordnode.insert x (subtype.val s), property := sorry }

protected instance has_insert {α : Type u_1} [preorder α] [is_total α LessEq] [DecidableRel LessEq] : has_insert α (ordset α) :=
  has_insert.mk ordset.insert

/-- O(log n). Insert an element into the set, preserving balance and the BST property.
  If an equivalent element is already in the set, the set is returned as is. -/
def insert' {α : Type u_1} [preorder α] [is_total α LessEq] [DecidableRel LessEq] (x : α) (s : ordset α) : ordset α :=
  { val := ordnode.insert' x (subtype.val s), property := sorry }


import analysis.p_series
import number_theory.arithmetic_function
import algebra.squarefree
import data.list.intervals
import tactic
import measure_theory.integral.interval_integral
import analysis.special_functions.integrals
import defs
import summability
import general

noncomputable theory
open nat finset list finsupp set function filter measure_theory
open_locale topological_space interval big_operators filter ennreal asymptotics

namespace squarefree_sums

lemma mem_Icc_Ico
{a b c : ℝ}
(hc : c ∈ set.Icc a b)
(hc' : c ≠ b) :
c ∈ set.Ico a b :=
begin
  simp, simp at hc,
  simp [hc.left],
  exact lt_of_le_of_ne hc.right hc',
end

lemma blech
{a m : ℕ}
{f : ℝ → ℝ}
(ham : a ≤ m)
(hf_nonneg : ∀ (b : ℝ), b ∈ set.Ici (a : ℝ) → 0 ≤ f b)
:
{x : ℝ | x ∈ set.Icc (m : ℝ) (↑m + 1) → 0 ≤ f x} = univ
:=
begin
  simp,
  apply eq_univ_of_forall,
  intros x,
  simp,
  intros hx hx',
  have : x ∈ set.Ici (a : ℝ),
    simp,
    calc (a : ℝ) ≤ ↑m : cast_le.mpr ham ... ≤ x : hx,
  exact hf_nonneg x this,
end

lemma tail_sum_le_tail_integral
{a : ℕ}
{l : ℝ}
{f : ℝ → ℝ}
(hf : tendsto (λ (b : ℕ), ∫ (x : ℝ) in a..b, f x) at_top (𝓝 l))
(hf_mono : antitone_on f (set.Ici (a : ℝ)))
(hf_nonneg : ∀ (b : ℝ), b ∈ set.Ici (a : ℝ) → 0 ≤ f b)
:
(∑' (i : ℕ), (λ (j : ℕ), ite (a + 1 ≤ j) (f ↑j) 0) i) ≤ l :=
begin
  by_cases h : summable (λ (j : ℕ), ite (a + 1 ≤ j) (f ↑j) 0),
  obtain ⟨c, hc⟩ := h,
  rw has_sum.tsum_eq hc,
  rw has_sum_iff_tendsto_nat_of_nonneg at hc,
  simp at hf,
  refine le_of_tendsto_of_tendsto hc hf _,
  rw [filter.eventually_le, eventually_at_top],
  use a + 100,
  intros n hn,
  rw sum_ite,
  simp,
  have : filter (has_le.le (a + 1)) (finset.range n) = finset.Ico (a + 1) n,
  {
    ext d,
    rw finset.mem_filter,
    simp,
    conv {to_lhs, rw and_comm},
  },
  rw this,
  obtain ⟨m, hm⟩ : ∃m, n = m + 1, {
    use n - 1,
    exact (nat.sub_add_cancel (calc 1 ≤ 100 : by linarith ... ≤ a + 100 : by linarith ... ≤ n : hn)).symm,
  },
  have : a ≤ m, {
    have : a + 1 ≤ m + 1, {
      rw ← hm,
      calc a + 1 ≤ a + 100 : by linarith ... ≤ n : hn,
    },
    linarith,
  },
  rw hm,
  transitivity,
  refine antitone_sum_le_integral this _,
  intros x hx y hy hxy,
  exact hf_mono (mem_Icc_mem_Ici hx) (mem_Icc_mem_Ici hy) hxy,

  have hf_mono_local: antitone_on f [(a : ℝ), ↑m + 1], {
    have : (n : ℝ) = (m : ℝ) + 1, simp [hm],
    rw ← this,
    rw interval_eq_Icc (cast_le.mpr (calc a ≤ a + 100 : by linarith ... ≤ n : hn)),
    intros x hx y hy hxy,
    exact hf_mono (mem_Icc_mem_Ici hx) (mem_Icc_mem_Ici hy) hxy,
  },
  have uu: interval_integrable f real.measure_space.volume ↑a (↑m + 1), {
    exact antitone_on.interval_integrable hf_mono_local,
  },

  have hf_mono_local: antitone_on f [(a : ℝ), ↑m], {
    rw interval_eq_Icc (cast_le.mpr this),
    intros x hx y hy hxy,
    exact hf_mono (mem_Icc_mem_Ici hx) (mem_Icc_mem_Ici hy) hxy,
  },
  have ul: interval_integrable f real.measure_space.volume ↑a ↑m, {
    exact antitone_on.interval_integrable hf_mono_local,
  },

  have hf_mono_local: antitone_on f [(m : ℝ), ↑m + 1], {
    rw interval_eq_Icc (calc (m : ℝ) ≤ ↑m + 1 : by simp),
    intros x hx y hy hxy,
    have ut : (m : ℝ) + 1 = ↑(m + 1), simp,
    rw ut at hx,
    rw ut at hy,
    exact hf_mono (mem_Icc_mem_Ici' hx this) (mem_Icc_mem_Ici' hy this) hxy,
  },
  have ur: interval_integrable f real.measure_space.volume ↑m (↑m + 1), {
    exact antitone_on.interval_integrable hf_mono_local,
  },

  have aa : interval_integral f ↑a ↑(m + 1) real.measure_space.volume = interval_integral f ↑a ↑m real.measure_space.volume + interval_integral f ↑m ↑(m + 1) real.measure_space.volume, {
    symmetry,
    refine interval_integral.integral_add_adjacent_intervals ul ur,
  },
  rw aa,
  simp,
  apply interval_integral.integral_nonneg_of_ae_restrict,
  simp,
  unfold filter.eventually_le,
  simp,
  rw filter.eventually_inf_principal,
  rw filter.eventually_iff,
  rw blech this hf_nonneg,
  simp,
  intros i,
  by_cases hi : a + 1 ≤ i,
  simp [hi],
  refine hf_nonneg i _,
  simp,
  calc a ≤ a + 1 : le_succ a ... ≤ i : hi,
  simp [hi],

  -- Now to the not summable case
  rw not_summable_eq_zero h,
  refine le_of_tendsto_of_tendsto (tendsto_const_nhds) hf _,
  rw [filter.eventually_le, eventually_at_top],
  use a + 1,
  intros x hx,
  apply interval_integral.integral_nonneg,
  norm_cast, linarith,
  intros u hu,
  exact hf_nonneg u (mem_Icc_mem_Ici hu),
end

theorem integral_tendsto_of_has_deriv_at {a b : ℝ} {f f' : ℝ → ℝ}
  (hderiv : ∀ x ∈ Ici a, has_deriv_at f (f' x) x)
  (hvanish : tendsto f at_top (𝓝 b))
  (hint : ∀ (b : ℝ), b ∈ Ici a → interval_integrable f' volume a b) :
  tendsto (λ (b : ℝ), ∫ y in a..b, f' y) at_top (𝓝 (b - f a)) :=
begin
  have hev : (λ (x : ℝ), f x - f a) =ᶠ[at_top] (λ (b : ℝ), ∫ y in a..b, f' y),
  { rw [eventually_eq, eventually_at_top],
    use a,
    intros b hb,
    have hderiv' : ∀ x ∈ [a, b], has_deriv_at f (f' x) x,
    { intros x hx,
      exact hderiv x (calc a = min a b : (min_eq_left hb.le).symm ... ≤ x : hx.left), },
    rw interval_integral.integral_eq_sub_of_has_deriv_at hderiv' (hint b hb.le), },
  exact tendsto.congr' hev (filter.tendsto.sub_const (f a) hvanish),
end

lemma integral_rpow_tendsto_at_top (a r : ℝ) (ha : 0 < a) (hr : r < -1) :
tendsto
(λ (y : ℝ), ∫ (x : ℝ) in a..y, x ^ r)
at_top
(𝓝 (-a ^ (r + 1) / (r + 1)))
:=
begin
  have : (λ (y : ℝ), ∫ (x : ℝ) in a..y, x ^ r) =ᶠ[at_top] (λ (y : ℝ), (y ^ (r + 1) / (r + 1)) - (a ^ (r + 1) / (r + 1))),
  { rw [eventually_eq, eventually_at_top],
    refine ⟨20, (λ b hb, _)⟩,
    rw integral_rpow,
    { ring, },
    { right,
      split,
      { linarith [hr], },
      { exact not_mem_interval_of_lt ha (by linarith [hb.le]), }, }, },
  rw tendsto_congr' this,
  have : -a ^ (r + 1) / (r + 1) = 0 - (a ^ (r + 1) / (r + 1)), { ring, },
  rw this,
  apply tendsto.sub_const,
  rw ← zero_div (r + 1),
  apply tendsto.div_const,
  have hinf : tendsto (λ (k : ℝ), k ^ -(r + 1)) at_top at_top,
  { apply tendsto_rpow_at_top,
    linarith [hr], },
  have hev : (λ (k : ℝ), k ^ -(r + 1)) =ᶠ[at_top] (λ (k : ℝ), (k ^ (r + 1))⁻¹),
  { rw [eventually_eq, eventually_at_top],
    use 0,
    intros b hb,
    rw [←real.inv_rpow hb.le, real.rpow_neg hb.le, ←real.inv_rpow hb.le], },
  refine tendsto.congr _ (tendsto_inv_at_top_zero.comp (tendsto.congr' hev hinf)),
  intros x,
  simp only [comp_app, inv_inv],
end

end squarefree_sums


import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume A : set (euclidean_space ℝ (fin n)),
  assume h1 : is_open_cover A,
  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  have h2 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_refinement A C ∧ is_locally_finite C ∧ is_open_cover C, from by auto [paracompact_space.paracompact_iff_locally_finite_open_refinement],
  -- First, we define a collection of pen balls.
  have h3 : ∃ B0 : set (euclidean_space ℝ (fin n)), is_open B0, from by auto [is_open_univ],
  -- Let $B_0 = \phi$,
  have h4 : ∃ B0 : set (euclidean_space ℝ (fin n)), is_open B0 ∧ B0 = ∅, from by auto [is_open_univ],
  -- and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$ centered at 0.
  have h5 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), is_open Bm, from by auto [is_open_ball],
  -- Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem,
  have h6 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), is_open Bm ∧ is_compact Bm, from by auto [is_open_ball, compact_iff_closed_inter_compact],
  -- so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$
  have h7 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), is_open Bm ∧ is_compact Bm ∧ is_finite (A ∩ Bm), from by auto [is_open_ball, compact_iff_closed_inter_compact, compact_iff_finite_open_cover, h1],
  -- and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$,
  have h8 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), is_open Bm ∧ is_compact Bm ∧ is_finite (A ∩ Bm) ∧ (A ∩ Bm) ⊆ (A ∩ (euclidean_space ℝ (fin n) \ (Bm - 1))), from by auto [is_open_ball, compact_iff_closed_inter_compact, compact_iff_finite_open_cover, h1],
  -- and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$).
  have h9 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open Cm ∧ is_open_refinement A Cm ∧ is_finite Cm, from by auto [is_open_ball, compact_iff_closed_inter_compact, compact_iff_finite_open_cover, h1],
  -- So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$.
  have h10 : ∃ C : set (euclidean_space ℝ (fin n)), is_open C ∧ is_open_refinement A C ∧ is_finite C, from by auto [is_open_ball, compact_iff_closed_inter_compact, compact_iff_finite_open_cover, h1],
  -- Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$,
  have h11 : ∀ x : euclidean_space ℝ (fin n), ∃ Bx : set (euclidean_space ℝ (fin n)), is_open Bx ∧ is_compact Bx ∧ is_finite (A ∩ Bx) ∧ (A ∩ Bx) ⊆ (A ∩ (euclidean_space ℝ (fin n) \ (Bx - 1))), from by auto [is_open_ball, compact_iff_closed_inter_compact, compact_iff_finite_open_cover, h1],
  -- there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$),
  have h12 : ∀ x : euclidean_space ℝ (fin n), ∃ Bx : set (euclidean_space ℝ (fin n)), is_open Bx ∧ is_compact Bx ∧ is_finite (A ∩ Bx) ∧ (A ∩ Bx) ⊆ (A ∩ (euclidean_space ℝ (fin n) \ (Bx - 1))) ∧ ∃ m : ℕ, x ∈ Bm, from by auto [is_open_ball, compact_iff_closed_inter_compact, compact_iff_finite_open_cover, h1],
  -- and so $x$ is an element of $\mathcal{C}_m$.
  have h13 : ∀ x : euclidean_space ℝ (fin n), ∃ Bx : set (euclidean_space ℝ (fin n)), is_open Bx ∧ is_compact Bx ∧ is_finite (A ∩ Bx) ∧ (A ∩ Bx) ⊆ (A ∩ (euclidean_space ℝ (fin n) \ (Bx - 1))) ∧ ∃ m : ℕ, x ∈ Bm ∧ x ∈ Cm, from by auto [is_open_ball, compact_iff_closed_inter_compact, compact_iff_finite_open_cover, h1],
  -- Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$,
  have h14 : ∀ x : euclidean_space ℝ (fin n), ∃ Bx : set (euclidean_space ℝ (fin n)), is_open Bx ∧ is_compact Bx ∧ is_finite (A ∩ Bx) ∧ (A ∩ Bx) ⊆ (A ∩ (euclidean_space ℝ (fin n) \ (Bx - 1))) ∧ ∃ m : ℕ, x ∈ Bm ∧ x ∈ Cm ∧ is_locally_finite Bx, from by auto [is_open_ball, compact_iff_closed_inter_compact, compact_iff_finite_open_cover, h1],
  -- neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$,
  have h15 : ∀ x : euclidean_space ℝ (fin n), ∃ Bx : set (euclidean_space ℝ (fin n)), is_open Bx ∧ is_compact Bx ∧ is_finite (A ∩ Bx) ∧ (A ∩ Bx) ⊆ (A ∩ (euclidean_space ℝ (fin n) \ (Bx - 1))) ∧ ∃ m : ℕ, x ∈ Bm ∧ x ∈ Cm ∧ is_loc
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume A : set (euclidean_space ℝ (fin n)),
  assume hA : is_open_cover A,
  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  have h1 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_cover C ∧ is_locally_finite_open_refinement A C, from by auto using [use A],
  -- First, we define a collection of pen balls.
  -- Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$ centered at 0.
  have h2 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), is_open Bm ∧ is_ball Bm (0 : euclidean_space ℝ (fin n)) m, from by auto using [use {x | ∃ i : fin n, x i ≤ m}],
  -- Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem,
  have h3 : ∀ m : ℕ, is_compact {x | ∃ i : fin n, x i ≤ m}, from by auto using [compact_iff_finite_open_cover, use {x | ∃ i : fin n, x i ≤ m}],
  -- so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$).
  have h4 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ A ∈ Cm, ∃ B ∈ A, (∀ x, x ∈ B → x ∈ {x | ∃ i : fin n, x i ≤ m}) ∧ (∀ x, x ∈ B → x ∉ {x | ∃ i : fin n, x i ≤ (m-1)})), from by auto using [use {x | ∃ i : fin n, x i ≤ m}],
  -- So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$.
  have h5 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_cover C ∧ is_open_refinement A C, from by auto using [use {x | ∃ i : fin n, x i ≤ m}],
  -- Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$.
  have h6 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ {x | ∃ i : fin n, x i ≤ m}, from by auto using [exists_nat_gt],
  -- Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$.
  have h7 : ∀ x : euclidean_space ℝ (fin n), is_locally_finite_open_refinement A {x | ∃ i : fin n, x i ≤ m}, from by auto using [use {x | ∃ i : fin n, x i ≤ m}],
  -- So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.
  show paracompact_space (euclidean_space ℝ (fin n)), from by auto using [use {x | ∃ i : fin n, x i ≤ m}],
end

--OUTPUT 3
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$
  assume A : set (euclidean_space ℝ (fin n)),
  assume hA : is_open_cover A,
  -- we now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$
  let C := {c : set (euclidean_space ℝ (fin n)) | ∃ a : set (euclidean_space ℝ (fin n)), a ∈ A ∧ c ⊆ a},
  let hC : is_open_refinement C A := by auto [is_open_refinement],
  have hC1 : is_open_cover C, from by auto [is_open_cover],
  have hC2 : is_locally_finite C, from by auto [is_locally_finite],
  have hC3 : is_cover C, from by auto [is_cover],
  -- so $\mathcal{C}$ is an open refinement of $\mathcal{A}$
  show ∃ C : set (euclidean_space ℝ (fin n)), is_open_refinement C A ∧ is_locally_finite C ∧ is_cover C, from by auto [hC, hC1, hC2, hC3],
end

--OUTPUT 4
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume A : set (euclidean_space ℝ (fin n)),
  assume hA : is_open_cover A,
  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  have h1 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_cover C ∧ is_locally_finite C ∧ is_open_refinement A C ∧ covers C, from by auto [paracompact_space.paracompact_iff_locally_finite_open_refinement],
  -- First, we define a collection of pen balls.
  have h2 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), is_open Bm ∧ is_ball Bm m ∧ is_compact (closure Bm), from by auto [euclidean_space.is_open_ball, euclidean_space.is_compact_closure],
  -- Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$ centered at 0.
  have h3 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), is_open Bm ∧ is_ball Bm m ∧ is_compact (closure Bm) ∧ Bm ⊆ (⋃ (A ∈ A), A), from by auto [hA, h2],
  -- Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$).
  have h4 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open Cm ∧ is_open_cover (Cm ∩ (⋃ (A ∈ A), A)) ∧ is_open_refinement Cm A ∧ Cm ⊆ (⋃ (A ∈ A), A), from by auto [hA, h3],
  -- So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$.
  have h5 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_refinement C A ∧ C ⊆ (⋃ (A ∈ A), A), from by auto [h4],
  -- Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$.
  have h6 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_refinement C A ∧ C ⊆ (⋃ (A ∈ A), A) ∧ covers C, from by auto [hA, h5],
  -- Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$.
  have h7 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_refinement C A ∧ is_locally_finite C ∧ C ⊆ (⋃ (A ∈ A), A) ∧ covers C, from by auto [hA, h6],
  -- So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.
  show paracompact_space (euclidean_space ℝ (fin n)), from by auto [paracompact_space.paracompact_iff_locally_finite_open_refinement, h7],
end

--OUTPUT 5
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume A : set (euclidean_space ℝ (fin n)),
  assume hA : is_open_cover A,

  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  let C := {U : set (euclidean_space ℝ (fin n)) | ∃ A ∈ A, ∃ V : set (euclidean_space ℝ (fin n)), A = V ∧ is_open V ∧ U ⊆ V},
  have hC : is_open_cover C, from by auto [is_open_cover_iff],

  -- First, we define a collection of pen balls.
  let B0 : set (euclidean_space ℝ (fin n)) := ∅,
  have hB0 : is_open B0, from by auto [is_open_empty],
  have hB0_1 : B0 ⊆ (euclidean_space ℝ (fin n)), from by auto [set.subset_empty],

  let B1 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∃ (m : ℝ), m > 0 ∧ ∀ (y : euclidean_space ℝ (fin n)), ∥x - y∥ < m → y ∈ B0},
  have hB1 : is_open B1, from by auto [is_open_ball],
  have hB1_1 : B1 ⊆ (euclidean_space ℝ (fin n)), from by auto [set.subset_univ],

  let B2 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∃ (m : ℝ), m > 0 ∧ ∀ (y : euclidean_space ℝ (fin n)), ∥x - y∥ < m → y ∈ B1},
  have hB2 : is_open B2, from by auto [is_open_ball],
  have hB2_1 : B2 ⊆ (euclidean_space ℝ (fin n)), from by auto [set.subset_univ],

  let B3 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∃ (m : ℝ), m > 0 ∧ ∀ (y : euclidean_space ℝ (fin n)), ∥x - y∥ < m → y ∈ B2},
  have hB3 : is_open B3, from by auto [is_open_ball],
  have hB3_1 : B3 ⊆ (euclidean_space ℝ (fin n)), from by auto [set.subset_univ],

  let B4 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∃ (m : ℝ), m > 0 ∧ ∀ (y : euclidean_space ℝ (fin n)), ∥x - y∥ < m → y ∈ B3},
  have hB4 : is_open B4, from by auto [is_open_ball],
  have hB4_1 : B4 ⊆ (euclidean_space ℝ (fin n)), from by auto [set.subset_univ],

  let B5 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∃ (m : ℝ), m > 0 ∧ ∀ (y : euclidean_space ℝ (fin n)), ∥x - y∥ < m → y ∈ B4},
  have hB5 : is_open B5, from by auto [is_open_ball],
  have hB5_1 : B5 ⊆ (euclidean_space ℝ (fin n)), from by auto [set.subset_univ],

  let B6 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∃ (m : ℝ), m > 0 ∧ ∀ (y : euclidean_space ℝ (fin n)), ∥x - y∥ < m → y ∈ B5},
  have hB6 : is_open B6, from by auto [is_open_ball],
  have hB6_1 : B6 ⊆ (euclidean_space ℝ (fin n)), from by auto [set.subset_univ],

  let B7 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∃ (m : ℝ), m > 0 ∧ ∀ (y : euclidean_space ℝ (fin n)), ∥x - y∥ < m → y ∈ B6},
  have hB7 : is_open B7, from by auto [is_open_ball],
  have hB7_1 : B7 ⊆ (euclidean_space ℝ (fin n)), from by auto [set.subset_univ],

  let B8 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∃ (m : ℝ), m > 0 ∧ ∀ (y : euclidean_space ℝ (fin n)), ∥x - y∥ < m → y ∈ B7},
  have hB8 : is_open B8, from by auto [is_open_ball],
  have hB8_1 : B8 ⊆ (euclidean_space ℝ (fin n)), from by auto [set.subset_univ],

  let B9 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∃ (m : ℝ), m > 0 ∧ ∀ (y : euclidean_space ℝ (fin n)), ∥x - y∥ < m → y ∈ B8},
  have hB9 : is_open B9, from by auto [is_open_ball],
  have hB9_1 : B9 ⊆ (euclidean_space ℝ (fin n)), from by auto [set.subset_univ],

  let B10 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∃ (m : ℝ), m > 0 ∧ ∀ (y : euclidean_space ℝ (fin n)), ∥x - y∥ < m → y ∈ B9},
  have hB10 : is_open B10, from by auto [is_open_ball],
  have hB10_1 : B10 ⊆ (euclidean_space ℝ (fin n)), from by auto [set.subset_univ],

  let B11 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∃ (m : ℝ), m > 0 ∧ ∀ (y : euclidean_space ℝ (fin n)), ∥x - y∥ < m → y ∈ B10},
  have hB11 : is_open B11, from by auto [is_open_ball],
  have hB11_1 : B11 ⊆ (euclidean_space ℝ (fin n)), from by auto [set.subset_univ],

  let B12 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∃ (m : ℝ), m > 0 ∧ ∀ (y : e
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$
  assume A : set (euclidean_space ℝ (fin n)),
  assume hA : is_open_cover A,

  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$
  -- First, we define a collection of pen balls. Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$ centered at 0.
  let B0 : set (euclidean_space ℝ (fin n)) := {x : euclidean_space ℝ (fin n) | ∀ i : fin n, x.val i = 0},
  have hB0 : is_open B0, from by auto [set.is_open_empty],
  let Bm : ℕ → set (euclidean_space ℝ (fin n)) := λ m, {x : euclidean_space ℝ (fin n) | ∀ i : fin n, abs (x.val i) ≤ m},
  have hBm : ∀ m : ℕ, is_open (Bm m), from by auto [set.is_open_ball],
  have hBm_subset : ∀ m : ℕ, Bm m ⊆ Bm (m+1), from by auto [set.subset_iff, abs_le_add],

  -- Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$).
  let Cm : ℕ → set (euclidean_space ℝ (fin n)) := λ m, (⋂ (a : set (euclidean_space ℝ (fin n))) (h : a ∈ A) (h2 : a ∩ (Bm m) ≠ ∅), a) ∩ (euclidean_space ℝ (fin n) \ Bm (m-1)),
  have hCm : ∀ m : ℕ, is_open (Cm m), from by auto [set.is_open_inter, set.is_open_diff],
  have hCm_subset : ∀ m : ℕ, Cm m ⊆ Bm m, from by auto [set.subset_iff, abs_le_add],
  have hCm_cover : ∀ m : ℕ, Cm m ≠ ∅, from by auto [set.inter_nonempty_iff, set.diff_nonempty_iff, hA, hBm_subset],

  -- So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$.
  let C : set (euclidean_space ℝ (fin n)) := ⋃ (m : ℕ), Cm m,
  have hC : is_open C, from by auto [set.is_open_union],
  have hC_cover : C ≠ ∅, from by auto [set.nonempty_union],

  -- Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$.
  have hC_cover_Rn : ∀ x : euclidean_space ℝ (fin n), x ∈ C, from by auto [set.mem_union, set.mem_inter, set.mem_diff, set.mem_inter_iff, set.mem_diff_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_inter_iff, set.mem_
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
\mathbb{R}^n is paracompact
$\mathbb{R}^n$ is paracompact for all $n$.
`proof`
Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$. We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$. First, we define a collection of pen balls. Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$
centered at 0. Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$). So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$. Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$. Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$. So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.

QED
-/
theorem  ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import for_mathlib.truncation
import for_mathlib.Ext_quasi_iso

noncomputable theory

universes v u

open category_theory category_theory.limits

namespace cochain_complex
open bounded_homotopy_category

variables {𝓐 : Type u} [category.{v} 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
variables (C : cochain_complex 𝓐 ℤ)

lemma Ext_ι_succ_five_term_exact_seq (B : bounded_homotopy_category 𝓐) (i j : ℤ) :
  let E := λ n, ((Ext n).flip.obj B) in
  exact_seq Ab.{v} $
    [
      (E j).map (bounded_homotopy_category.of_hom (truncation.to_imker C (i+1))).op
    , (E j).map (bounded_homotopy_category.of_hom (truncation.ι_succ C i)).op
    , Ext_δ _ _ j B (truncation.short_exact_ι_succ_to_imker C i)
    , (E (j+1)).map (bounded_homotopy_category.of_hom (truncation.to_imker C (i+1))).op ] :=
Ext_five_term_exact_seq' _ _ j B (truncation.short_exact_ι_succ_to_imker C i)

end cochain_complex


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

/-!
# Extra definitions on `option`

This file defines more operations involving `option α`. Lemmas about them are located in other
files under `data.option.`.
Other basic operations on `option` are defined in the core library.
-/

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

attribute [inline] option.is_some option.is_none

/-- An elimination principle for `option`. It is a nondependent version of `option.rec_on`. -/
@[simp] protected def elim : option α → β → (α → β) → β
| (some x) y f := f x
| none     y f := y

instance has_mem : has_mem α (option α) := ⟨λ a b, b = some a⟩

@[simp] theorem mem_def {a : α} {b : option α} : a ∈ b ↔ b = some a :=
iff.rfl

lemma mem_iff {a : α} {b : option α} : a ∈ b ↔ b = a := iff.rfl

theorem is_none_iff_eq_none {o : option α} : o.is_none = tt ↔ o = none :=
⟨option.eq_none_of_is_none, λ e, e.symm ▸ rfl⟩

theorem some_inj {a b : α} : some a = some b ↔ a = b := by simp

lemma mem_some_iff {α : Type*} {a b : α} : a ∈ some b ↔ b = a :=
by simp

/--
`o = none` is decidable even if the wrapped type does not have decidable equality.

This is not an instance because it is not definitionally equal to `option.decidable_eq`.
Try to use `o.is_none` or `o.is_some` instead.
-/
@[inline]
def decidable_eq_none {o : option α} : decidable (o = none) :=
decidable_of_decidable_of_iff (bool.decidable_eq _ _) is_none_iff_eq_none

instance decidable_forall_mem {p : α → Prop} [decidable_pred p] :
  ∀ o : option α, decidable (∀ a ∈ o, p a)
| none     := is_true (by simp [false_implies_iff])
| (some a) := if h : p a
  then is_true $ λ o e, some_inj.1 e ▸ h
  else is_false $ mt (λ H, H _ rfl) h

instance decidable_exists_mem {p : α → Prop} [decidable_pred p] :
  ∀ o : option α, decidable (∃ a ∈ o, p a)
| none     := is_false (λ ⟨a, ⟨h, _⟩⟩, by cases h)
| (some a) := if h : p a
  then is_true $ ⟨_, rfl, h⟩
  else is_false $ λ ⟨_, ⟨rfl, hn⟩⟩, h hn

/-- Inhabited `get` function. Returns `a` if the input is `some a`, otherwise returns `default`. -/
@[reducible] def iget [inhabited α] : option α → α
| (some x) := x
| none     := default

@[simp] theorem iget_some [inhabited α] {a : α} : (some a).iget = a := rfl

/-- `guard p a` returns `some a` if `p a` holds, otherwise `none`. -/
def guard (p : α → Prop) [decidable_pred p] (a : α) : option α :=
if p a then some a else none

/-- `filter p o` returns `some a` if `o` is `some a` and `p a` holds, otherwise `none`. -/
def filter (p : α → Prop) [decidable_pred p] (o : option α) : option α :=
o.bind (guard p)

/-- Cast of `option` to `list `. Returns `[a]` if the input is `some a`, and `[]` if it is
`none`. -/
def to_list : option α → list α
| none     := []
| (some a) := [a]

@[simp] theorem mem_to_list {a : α} {o : option α} : a ∈ to_list o ↔ a ∈ o :=
by cases o; simp [to_list, eq_comm]

/-- Two arguments failsafe function. Returns `f a b` if the inputs are `some a` and `some b`, and
"does nothing" otherwise. -/
def lift_or_get (f : α → α → α) : option α → option α → option α
| none     none     := none
| (some a) none     := some a       -- get a
| none     (some b) := some b       -- get b
| (some a) (some b) := some (f a b) -- lift f

instance lift_or_get_comm (f : α → α → α) [h : is_commutative α f] :
  is_commutative (option α) (lift_or_get f) :=
⟨λ a b, by cases a; cases b; simp [lift_or_get, h.comm]⟩

instance lift_or_get_assoc (f : α → α → α) [h : is_associative α f] :
  is_associative (option α) (lift_or_get f) :=
⟨λ a b c, by cases a; cases b; cases c; simp [lift_or_get, h.assoc]⟩

instance lift_or_get_idem (f : α → α → α) [h : is_idempotent α f] :
  is_idempotent (option α) (lift_or_get f) :=
⟨λ a, by cases a; simp [lift_or_get, h.idempotent]⟩

instance lift_or_get_is_left_id (f : α → α → α) :
  is_left_id (option α) (lift_or_get f) none :=
⟨λ a, by cases a; simp [lift_or_get]⟩

instance lift_or_get_is_right_id (f : α → α → α) :
  is_right_id (option α) (lift_or_get f) none :=
⟨λ a, by cases a; simp [lift_or_get]⟩

/-- Lifts a relation `α → β → Prop` to a relation `option α → option β → Prop` by just adding
`none ~ none`. -/
inductive rel (r : α → β → Prop) : option α → option β → Prop
/-- If `a ~ b`, then `some a ~ some b` -/
| some {a b} : r a b → rel (some a) (some b)
/-- `none ~ none` -/
| none       : rel none none

/-- Partial bind. If for some `x : option α`, `f : Π (a : α), a ∈ x → option β` is a
  partial function defined on `a : α` giving an `option β`, where `some a = x`,
  then `pbind x f h` is essentially the same as `bind x f`
  but is defined only when all `x = some a`, using the proof to apply `f`. -/
@[simp] def pbind : Π (x : option α), (Π (a : α), a ∈ x → option β) → option β
| none     _ := none
| (some a) f := f a rfl

/-- Partial map. If `f : Π a, p a → β` is a partial function defined on `a : α` satisfying `p`,
then `pmap f x h` is essentially the same as `map f x` but is defined only when all members of `x`
satisfy `p`, using the proof to apply `f`. -/
@[simp] def pmap {p : α → Prop} (f : Π (a : α), p a → β) :
  Π x : option α, (∀ a ∈ x, p a) → option β
| none     _ := none
| (some a) H := some (f a (H a (mem_def.mpr rfl)))

/-- Flatten an `option` of `option`, a specialization of `mjoin`. -/
@[simp] def join : option (option α) → option α :=
λ x, bind x id

protected def {u v} traverse {F : Type u → Type v} [applicative F] {α β : Type*} (f : α → F β) :
  option α → F (option β)
| none     := pure none
| (some x) := some <$> f x

/- By analogy with `monad.sequence` in `init/category/combinators.lean`. -/

/-- If you maybe have a monadic computation in a `[monad m]` which produces a term of type `α`, then
there is a naturally associated way to always perform a computation in `m` which maybe produces a
result. -/
def {u v} maybe {m : Type u → Type v} [monad m] {α : Type u} : option (m α) → m (option α)
| none      := return none
| (some fn) := some <$> fn

/-- Map a monadic function `f : α → m β` over an `o : option α`, maybe producing a result. -/
def {u v w} mmap {m : Type u → Type v} [monad m] {α : Type w} {β : Type u} (f : α → m β)
  (o : option α) : m (option β) := (o.map f).maybe

/-- A monadic analogue of `option.elim`. -/
def melim {α β : Type*} {m : Type* → Type*} [monad m] (x : m (option α)) (y : m β) (z : α → m β) :
  m β :=
x >>= λ o, option.elim o y z

/-- A monadic analogue of `option.get_or_else`. -/
def mget_or_else {α : Type*} {m : Type* → Type*} [monad m] (x : m (option α)) (y : m α) : m α :=
melim x y pure

end option


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

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Group action on rings applied to polynomials

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

namespace polynomial

protected instance mul_semiring_action (M : Type u_1) [monoid M] (R : Type u_2) [semiring R] [mul_semiring_action M R] : mul_semiring_action M (polynomial R) :=
  mul_semiring_action.mk sorry sorry

protected instance faithful_mul_semiring_action (M : Type u_1) [monoid M] (R : Type u_2) [semiring R] [faithful_mul_semiring_action M R] : faithful_mul_semiring_action M (polynomial R) :=
  faithful_mul_semiring_action.mk sorry

@[simp] theorem coeff_smul' {M : Type u_1} [monoid M] {R : Type u_2} [semiring R] [mul_semiring_action M R] (m : M) (p : polynomial R) (n : ℕ) : coeff (m • p) n = m • coeff p n :=
  coeff_map (mul_semiring_action.to_semiring_hom M R m) n

@[simp] theorem smul_C {M : Type u_1} [monoid M] {R : Type u_2} [semiring R] [mul_semiring_action M R] (m : M) (r : R) : m • coe_fn C r = coe_fn C (m • r) :=
  map_C (mul_semiring_action.to_semiring_hom M R m)

@[simp] theorem smul_X {M : Type u_1} [monoid M] {R : Type u_2} [semiring R] [mul_semiring_action M R] (m : M) : m • X = X :=
  map_X (mul_semiring_action.to_semiring_hom M R m)

theorem smul_eval_smul {M : Type u_1} [monoid M] (S : Type u_3) [comm_semiring S] [mul_semiring_action M S] (m : M) (f : polynomial S) (x : S) : eval (m • x) (m • f) = m • eval x f := sorry

theorem eval_smul' (S : Type u_3) [comm_semiring S] (G : Type u_4) [group G] [mul_semiring_action G S] (g : G) (f : polynomial S) (x : S) : eval (g • x) f = g • eval x (g⁻¹ • f) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (eval (g • x) f = g • eval x (g⁻¹ • f))) (Eq.symm (smul_eval_smul S g (g⁻¹ • f) x))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (eval (g • x) f = eval (g • x) (g • g⁻¹ • f))) (smul_inv_smul g f)))
      (Eq.refl (eval (g • x) f)))

theorem smul_eval (S : Type u_3) [comm_semiring S] (G : Type u_4) [group G] [mul_semiring_action G S] (g : G) (f : polynomial S) (x : S) : eval x (g • f) = g • eval (g⁻¹ • x) f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (eval x (g • f) = g • eval (g⁻¹ • x) f)) (Eq.symm (smul_eval_smul S g f (g⁻¹ • x)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (eval x (g • f) = eval (g • g⁻¹ • x) (g • f))) (smul_inv_smul g x)))
      (Eq.refl (eval x (g • f))))

end polynomial

/-- the product of `(X - g • x)` over distinct `g • x`. -/
def prod_X_sub_smul (G : Type u_2) [group G] [fintype G] (R : Type u_3) [comm_ring R] [mul_semiring_action G R] (x : R) : polynomial R :=
  finset.prod finset.univ
    fun (g : quotient_group.quotient (mul_action.stabilizer G x)) =>
      polynomial.X - coe_fn polynomial.C (mul_action.of_quotient_stabilizer G x g)

theorem prod_X_sub_smul.monic (G : Type u_2) [group G] [fintype G] (R : Type u_3) [comm_ring R] [mul_semiring_action G R] (x : R) : polynomial.monic (prod_X_sub_smul G R x) := sorry

theorem prod_X_sub_smul.eval (G : Type u_2) [group G] [fintype G] (R : Type u_3) [comm_ring R] [mul_semiring_action G R] (x : R) : polynomial.eval x (prod_X_sub_smul G R x) = 0 := sorry

theorem prod_X_sub_smul.smul (G : Type u_2) [group G] [fintype G] (R : Type u_3) [comm_ring R] [mul_semiring_action G R] (x : R) (g : G) : g • prod_X_sub_smul G R x = prod_X_sub_smul G R x := sorry

theorem prod_X_sub_smul.coeff (G : Type u_2) [group G] [fintype G] (R : Type u_3) [comm_ring R] [mul_semiring_action G R] (x : R) (g : G) (n : ℕ) : g • polynomial.coeff (prod_X_sub_smul G R x) n = polynomial.coeff (prod_X_sub_smul G R x) n := sorry

namespace mul_semiring_action_hom

/-- An equivariant map induces an equivariant map on polynomials. -/
protected def polynomial {M : Type u_1} [monoid M] {P : Type u_2} [comm_semiring P] [mul_semiring_action M P] {Q : Type u_3} [comm_semiring Q] [mul_semiring_action M Q] (g : mul_semiring_action_hom M P Q) : mul_semiring_action_hom M (polynomial P) (polynomial Q) :=
  mk (polynomial.map ↑g) sorry sorry sorry sorry sorry

@[simp] theorem coe_polynomial {M : Type u_1} [monoid M] {P : Type u_2} [comm_semiring P] [mul_semiring_action M P] {Q : Type u_3} [comm_semiring Q] [mul_semiring_action M Q] (g : mul_semiring_action_hom M P Q) : ⇑(mul_semiring_action_hom.polynomial g) = polynomial.map ↑g :=
  rfl


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import data.set.basic
import tactic.monotonicity.basic

/-!
# Typeclass for types with a set-like extensionality property

The `has_mem` typeclass is used to let terms of a type have elements.
Many instances of `has_mem` have a set-like extensionality property:
things are equal iff they have the same elements.  The `set_like`
typeclass provides a unified interface to define a `has_mem` that is
extensional in this way.

The main use of `set_like` is for algebraic subobjects (such as
`submonoid` and `submodule`), whose non-proof data consists only of a
carrier set.  In such a situation, the projection to the carrier set
is injective.

In general, a type `A` is `set_like` with elements of type `B` if it
has an injective map to `set B`.  This module provides standard
boilerplate for every `set_like`: a `coe_sort`, a `coe` to set, a
`partial_order`, and various extensionality and simp lemmas.

A typical subobject should be declared as:
```
structure my_subobject (X : Type*) :=
(carrier : set X)
(op_mem : ∀ {x : X}, x ∈ carrier → sorry ∈ carrier)

namespace my_subobject

variables (X : Type*)

instance : set_like (my_subobject X) X :=
⟨sub_mul_action.carrier, λ p q h, by cases p; cases q; congr'⟩

@[simp] lemma mem_carrier {p : my_subobject X} : x ∈ p.carrier ↔ x ∈ (p : set X) := iff.rfl

@[ext] theorem ext {p q : my_subobject X} (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q := set_like.ext h

/-- Copy of a `my_subobject` with a new `carrier` equal to the old one. Useful to fix definitional
equalities. See Note [range copy pattern]. -/
protected def copy (p : my_subobject X) (s : set X) (hs : s = ↑p) : my_subobject X :=
{ carrier := s,
  op_mem' := hs.symm ▸ p.op_mem' }

@[simp] lemma coe_copy (p : my_subobject X) (s : set X) (hs : s = ↑p) :
  (p.copy s hs : set X) = s := rfl

lemma copy_eq (p : my_subobject X) (s : set X) (hs : s = ↑p) : p.copy s hs = p :=
set_like.coe_injective hs

end my_subobject
```

An alternative to `set_like` could have been an extensional `has_mem` typeclass:
```
class has_ext_mem (α : out_param $ Type u) (β : Type v) extends has_mem α β :=
(ext_iff : ∀ {s t : β}, s = t ↔ ∀ (x : α), x ∈ s ↔ x ∈ t)
```
While this is equivalent, `set_like` conveniently uses a carrier set projection directly.

## Tags

subobjects
-/

/-- A class to indicate that there is a canonical injection between `A` and `set B`.

This has the effect of giving terms of `A` elements of type `B` (through a `has_mem`
instance) and a compatible coercion to `Type*` as a subtype.

Note: if `set_like.coe` is a projection, implementers should create a simp lemma such as
```
@[simp] lemma mem_carrier {p : my_subobject X} : x ∈ p.carrier ↔ x ∈ (p : set X) := iff.rfl
```
to normalize terms.
-/
@[protect_proj]
class set_like (A : Type*) (B : out_param $ Type*) :=
(coe : A → set B)
(coe_injective' : function.injective coe)

namespace set_like

variables {A : Type*} {B : Type*} [i : set_like A B]

include i

instance : has_coe_t A (set B) := ⟨set_like.coe⟩

@[priority 100]
instance : has_mem B A := ⟨λ x p, x ∈ (p : set B)⟩

-- `dangerous_instance` does not know that `B` is used only as an `out_param`
@[nolint dangerous_instance, priority 100]
instance : has_coe_to_sort A Type* := ⟨λ p, {x : B // x ∈ p}⟩

variables (p q : A)

@[simp, norm_cast] theorem coe_sort_coe : ((p : set B) : Type*) = p := rfl

variables {p q}

protected theorem «exists» {q : p → Prop} :
  (∃ x, q x) ↔ (∃ x ∈ p, q ⟨x, ‹_›⟩) := set_coe.exists

protected theorem «forall» {q : p → Prop} :
  (∀ x, q x) ↔ (∀ x ∈ p, q ⟨x, ‹_›⟩) := set_coe.forall

theorem coe_injective : function.injective (coe : A → set B) :=
λ x y h, set_like.coe_injective' h

@[simp, norm_cast]

theorem ext' (h : (p : set B) = q) : p = q := coe_injective h

theorem ext'_iff : p = q ↔ (p : set B) = q := coe_set_eq.symm

/-- Note: implementers of `set_like` must copy this lemma in order to tag it with `@[ext]`. -/
theorem ext (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q := coe_injective $ set.ext h

theorem ext_iff : p = q ↔ (∀ x, x ∈ p ↔ x ∈ q) := coe_injective.eq_iff.symm.trans set.ext_iff

@[simp] theorem mem_coe {x : B} : x ∈ (p : set B) ↔ x ∈ p := iff.rfl

@[simp, norm_cast] lemma coe_eq_coe {x y : p} : (x : B) = y ↔ x = y := subtype.ext_iff_val.symm

@[simp, norm_cast] lemma coe_mk (x : B) (hx : x ∈ p) : ((⟨x, hx⟩ : p) : B) = x := rfl
@[simp] lemma coe_mem (x : p) : (x : B) ∈ p := x.2

@[simp] protected lemma eta (x : p) (hx : (x : B) ∈ p) : (⟨x, hx⟩ : p) = x := subtype.eta x hx

-- `dangerous_instance` does not know that `B` is used only as an `out_param`
@[nolint dangerous_instance, priority 100]
instance : partial_order A :=
{ le := λ H K, ∀ ⦃x⦄, x ∈ H → x ∈ K,
  .. partial_order.lift (coe : A → set B) coe_injective }

lemma le_def {S T : A} : S ≤ T ↔ ∀ ⦃x : B⦄, x ∈ S → x ∈ T := iff.rfl

@[simp, norm_cast]
lemma coe_subset_coe {S T : A} : (S : set B) ⊆ T ↔ S ≤ T := iff.rfl

@[mono] lemma coe_mono : monotone (coe : A → set B) := λ a b, coe_subset_coe.mpr

@[simp, norm_cast]
lemma coe_ssubset_coe {S T : A} : (S : set B) ⊂ T ↔ S < T := iff.rfl

@[mono] lemma coe_strict_mono : strict_mono (coe : A → set B) := λ a b, coe_ssubset_coe.mpr

lemma not_le_iff_exists : ¬(p ≤ q) ↔ ∃ x ∈ p, x ∉ q := set.not_subset

lemma exists_of_lt : p < q → ∃ x ∈ q, x ∉ p := set.exists_of_ssubset

lemma lt_iff_le_and_exists : p < q ↔ p ≤ q ∧ ∃ x ∈ q, x ∉ p :=
by rw [lt_iff_le_not_le, not_le_iff_exists]

end set_like