/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import tactic.rcases
/-!
# lift tactic

This file defines the `lift` tactic, allowing the user to lift elements from one type to another
under a specified condition.

## Tags

lift, tactic
-/

universe variables u v w

/-- A class specifying that you can lift elements from `α` to `β` assuming `cond` is true.
  Used by the tactic `lift`. -/
class can_lift (α : Type u) (β : Type v) : Type (max u v) :=
(coe : β → α)
(cond : α → Prop)
(prf : ∀(x : α), cond x → ∃(y : β), coe y = x)

open tactic

/--
A user attribute used internally by the `lift` tactic.
This should not be applied by hand.
-/
@[user_attribute]
meta def can_lift_attr : user_attribute (list name) :=
{ name := "_can_lift",
  descr := "internal attribute used by the lift tactic",
  cache_cfg := { mk_cache := λ _,
    do { ls ← attribute.get_instances `instance,
        ls.mfilter $ λ l,
        do { (_,t) ← mk_const l >>= infer_type >>= open_pis,
         return $ t.is_app_of `can_lift } },
  dependencies := [`instance] } }

instance : can_lift ℤ ℕ :=
⟨coe, λ n, 0 ≤ n, λ n hn, ⟨n.nat_abs, int.nat_abs_of_nonneg hn⟩⟩

/-- Enable automatic handling of pi types in `can_lift`. -/
instance pi.can_lift (ι : Type u) (α : Π i : ι, Type v) (β : Π i : ι, Type w)
  [Π i : ι, can_lift (α i) (β i)] :
  can_lift (Π i : ι, α i) (Π i : ι, β i) :=
{ coe := λ f i, can_lift.coe (f i),
  cond := λ f, ∀ i, can_lift.cond (β i) (f i),
  prf := λ f hf, ⟨λ i, classical.some (can_lift.prf (f i) (hf i)), funext $ λ i,
    classical.some_spec (can_lift.prf (f i) (hf i))⟩ }

instance pi_subtype.can_lift (ι : Type u) (α : Π i : ι, Type v) [ne : Π i, nonempty (α i)]
  (p : ι → Prop) :
  can_lift (Π i : subtype p, α i) (Π i, α i) :=
{ coe := λ f i, f i,
  cond := λ _, true,
  prf :=
    begin
      classical,
      refine λ f _, ⟨λ i, if hi : p i then f ⟨i, hi⟩ else classical.choice (ne i), funext _⟩,
      rintro ⟨i, hi⟩,
      exact dif_pos hi
    end }

instance pi_subtype.can_lift' (ι : Type u) (α : Type v) [ne : nonempty α] (p : ι → Prop) :
  can_lift (subtype p → α) (ι → α) :=
pi_subtype.can_lift ι (λ _, α) p

namespace tactic

/--
Construct the proof of `cond x` in the lift tactic.
*  `e` is the expression being lifted and `h` is the specified proof of `can_lift.cond e`.
*  `old_tp` and `new_tp` are the arguments to `can_lift` and `inst` is the `can_lift`-instance.
*  `s` and `to_unfold` contain the information of the simp set used to simplify.

If the proof was specified, we check whether it has the correct type.
If it doesn't have the correct type, we display an error message
(but first call dsimp on the expression in the message).

If the proof was not specified, we create assert it as a local constant.
(The name of this local constant doesn't matter, since `lift` will remove it from the context.)
-/
meta def get_lift_prf (h : option pexpr) (old_tp new_tp inst e : expr)
  (s : simp_lemmas) (to_unfold : list name) : tactic expr :=
if h_some : h.is_some then
  (do prf ← i_to_expr (option.get h_some), prf_ty ← infer_type prf,
  expected_prf_ty ← mk_app `can_lift.cond [old_tp, new_tp, inst, e],
  unify prf_ty expected_prf_ty <|>
    (do expected_prf_ty2 ← s.dsimplify to_unfold expected_prf_ty,
      pformat!"lift tactic failed. The type of\n  {prf}\nis\n  {prf_ty}\nbut it is expected to be\n  {expected_prf_ty2}" >>= fail),
  return prf)
  else (do prf_nm ← get_unused_name,
    prf ← mk_app `can_lift.cond [old_tp, new_tp, inst, e] >>= assert prf_nm,
    dsimp_target s to_unfold {}, swap, return prf)

/-- Lift the expression `p` to the type `t`, with proof obligation given by `h`.
  The list `n` is used for the two newly generated names, and to specify whether `h` should
  remain in the local context. See the doc string of `tactic.interactive.lift` for more information.
  -/
meta def lift (p : pexpr) (t : pexpr) (h : option pexpr) (n : list name) : tactic unit :=
do
  propositional_goal <|>
    fail "lift tactic failed. Tactic is only applicable when the target is a proposition.",
  e ← i_to_expr p,
  old_tp ← infer_type e,
  new_tp ← i_to_expr t,
  inst_type ← mk_app ``can_lift [old_tp, new_tp],
  inst ← mk_instance inst_type <|>
    pformat!"Failed to find a lift from {old_tp} to {new_tp}. Provide an instance of\n  {inst_type}"
    >>= fail,
  /- make the simp set to get rid of `can_lift` projections -/
  can_lift_instances ← can_lift_attr.get_cache >>= λ l, l.mmap resolve_name,
  (s, to_unfold) ← mk_simp_set tt [] $ can_lift_instances.map simp_arg_type.expr,
  prf_cond ← get_lift_prf h old_tp new_tp inst e s to_unfold,
  let prf_nm := if prf_cond.is_local_constant then some prf_cond.local_pp_name else none,
  /- We use mk_mapp to apply `can_lift.prf` to all but one argument, and then just use expr.app
  for the last argument. For some reason we get an error when applying mk_mapp it to all
  arguments. -/
  prf_ex0 ← mk_mapp `can_lift.prf [old_tp, new_tp, inst, e],
  let prf_ex := prf_ex0 prf_cond,
  /- Find the name of the new variable -/
  new_nm ← if n ≠ [] then return n.head
    else if e.is_local_constant then return e.local_pp_name
    else get_unused_name,
  /- Find the name of the proof of the equation -/
  eq_nm ← if hn : 1 < n.length then return (n.nth_le 1 hn)
    else if e.is_local_constant then return `rfl
    else get_unused_name `h,
  /- We add the proof of the existential statement to the context and then apply
  `dsimp` to it, unfolding all `can_lift` instances. -/
  temp_nm ← get_unused_name,
  temp_e ← note temp_nm none prf_ex,
  dsimp_hyp temp_e s to_unfold {},
  /- We case on the existential. We use `rcases` because `eq_nm` could be `rfl`. -/
  rcases none (pexpr.of_expr temp_e) $ rcases_patt.tuple ([new_nm, eq_nm].map rcases_patt.one),
  /- If the lifted variable is not a local constant,
    try to rewrite it away using the new equality. -/
  when (¬ e.is_local_constant) (get_local eq_nm >>=
    λ e, interactive.rw ⟨[⟨⟨0, 0⟩, tt, (pexpr.of_expr e)⟩], none⟩ interactive.loc.wildcard),
  /- If the proof `prf_cond` is a local constant, remove it from the context,
    unless `n` specifies to keep it. -/
  if h_prf_nm : prf_nm.is_some ∧ n.nth 2 ≠ prf_nm then
    get_local (option.get h_prf_nm.1) >>= clear else skip

open lean.parser interactive interactive.types

local postfix `?`:9001 := optional
/-- Parses an optional token "using" followed by a trailing `pexpr`. -/
meta def using_texpr := (tk "using" *> texpr)?

/-- Parses a token "to" followed by a trailing `pexpr`. -/
meta def to_texpr := (tk "to" *> texpr)

namespace interactive

/--
Lift an expression to another type.
* Usage: `'lift' expr 'to' expr ('using' expr)? ('with' id (id id?)?)?`.
* If `n : ℤ` and `hn : n ≥ 0` then the tactic `lift n to ℕ using hn` creates a new
  constant of type `ℕ`, also named `n` and replaces all occurrences of the old variable `(n : ℤ)`
  with `↑n` (where `n` in the new variable). It will remove `n` and `hn` from the context.
  + So for example the tactic `lift n to ℕ using hn` transforms the goal
    `n : ℤ, hn : n ≥ 0, h : P n ⊢ n = 3` to `n : ℕ, h : P ↑n ⊢ ↑n = 3`
    (here `P` is some term of type `ℤ → Prop`).
* The argument `using hn` is optional, the tactic `lift n to ℕ` does the same, but also creates a
  new subgoal that `n ≥ 0` (where `n` is the old variable).
  + So for example the tactic `lift n to ℕ` transforms the goal
    `n : ℤ, h : P n ⊢ n = 3` to two goals
    `n : ℕ, h : P ↑n ⊢ ↑n = 3` and `n : ℤ, h : P n ⊢ n ≥ 0`.
* You can also use `lift n to ℕ using e` where `e` is any expression of type `n ≥ 0`.
* Use `lift n to ℕ with k` to specify the name of the new variable.
* Use `lift n to ℕ with k hk` to also specify the name of the equality `↑k = n`. In this case, `n`
  will remain in the context. You can use `rfl` for the name of `hk` to substitute `n` away
  (i.e. the default behavior).
* You can also use `lift e to ℕ with k hk` where `e` is any expression of type `ℤ`.
  In this case, the `hk` will always stay in the context, but it will be used to rewrite `e` in
  all hypotheses and the target.
  + So for example the tactic `lift n + 3 to ℕ using hn with k hk` transforms the goal
    `n : ℤ, hn : n + 3 ≥ 0, h : P (n + 3) ⊢ n + 3 = 2 * n` to the goal
    `n : ℤ, k : ℕ, hk : ↑k = n + 3, h : P ↑k ⊢ ↑k = 2 * n`.
* The tactic `lift n to ℕ using h` will remove `h` from the context. If you want to keep it,
  specify it again as the third argument to `with`, like this: `lift n to ℕ using h with n rfl h`.
* More generally, this can lift an expression from `α` to `β` assuming that there is an instance
  of `can_lift α β`. In this case the proof obligation is specified by `can_lift.cond`.
* Given an instance `can_lift β γ`, it can also lift `α → β` to `α → γ`; more generally, given
  `β : Π a : α, Type*`, `γ : Π a : α, Type*`, and `[Π a : α, can_lift (β a) (γ a)]`, it
  automatically generates an instance `can_lift (Π a, β a) (Π a, γ a)`.

`lift` is in some sense dual to the `zify` tactic. `lift (z : ℤ) to ℕ` will change the type of an
integer `z` (in the supertype) to `ℕ` (the subtype), given a proof that `z ≥ 0`;
propositions concerning `z` will still be over `ℤ`. `zify` changes propositions about `ℕ` (the
subtype) to propositions about `ℤ` (the supertype), without changing the type of any variable.
-/
meta def lift (p : parse texpr) (t : parse to_texpr) (h : parse using_texpr)
  (n : parse with_ident_list) : tactic unit :=
tactic.lift p t h n

add_tactic_doc
{ name       := "lift",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.lift],
  tags       := ["coercions"] }

end interactive
end tactic


import tactic.basic

-- Lean version 3.45.0

section

parameters (C : Type) [decidable_eq C]

inductive term : Type
| var : ℕ → term
| const : C → term
| app : term → term → term
| lam : term → term → term
| pi : term → term → term

instance : decidable_eq term :=
begin
  intros a a',
  induction a with x c f a ih₁ ih₂ A b ih₁ ih₂ A B ih₁ ih₂ generalizing a',
  { cases a' with x'; try { apply is_false, intro h, cases h, done },
    by_cases h : x = x',
    { subst h,
      exact is_true rfl },
    { apply is_false,
      intro h',
      cases h',
      exact h rfl } },
  { cases a' with _ c'; try { apply is_false, intro h, cases h, done },
    by_cases h : c = c',
    { subst h,
      exact is_true rfl },
    { apply is_false,
      intro h',
      cases h',
      exact h rfl } },
  { cases a' with _ _ f' a'; try { apply is_false, intro h, cases h, done },
    specialize ih₁ f',
    specialize ih₂ a',
    cases ih₁, apply is_false, intro h, cases h, exact ih₁ rfl,
    cases ih₂, apply is_false, intro h, cases h, exact ih₂ rfl,
    subst ih₁, subst ih₂,
    exact is_true rfl },
  { cases a' with _ _ _ _ A' b'; try { apply is_false, intro h, cases h, done },
    specialize ih₁ A',
    specialize ih₂ b',
    cases ih₁, apply is_false, intro h, cases h, exact ih₁ rfl,
    cases ih₂, apply is_false, intro h, cases h, exact ih₂ rfl,
    subst ih₁, subst ih₂,
    exact is_true rfl },
  { cases a' with _ _ _ _ _ _ A' B'; try { apply is_false, intro h, cases h, done },
    specialize ih₁ A',
    specialize ih₂ B',
    cases ih₁, apply is_false, intro h, cases h, exact ih₁ rfl,
    cases ih₂, apply is_false, intro h, cases h, exact ih₂ rfl,
    subst ih₁, subst ih₂,
    exact is_true rfl }
end

instance has_coe_var : has_coe ℕ term := ⟨term.var⟩
instance has_coe_const : has_coe C term := ⟨term.const⟩

def shift (σ : ℕ → term) : ℕ → term
| 0 := term.var 0
| (x + 1) := σ x

def substs : (ℕ → term) → term → term
| σ (term.var x) := σ x
| σ (term.const c) := term.const c
| σ (term.app f a) := term.app (substs σ f) (substs σ a)
| σ (term.lam A b) := term.lam (substs σ A) (substs (shift σ) b)
| σ (term.pi A B) := term.lam (substs σ A) (substs (shift σ) B)

def subst.weak : term → term :=
substs (term.var ∘ nat.succ)

def subst (a : term) : term → term :=
let σ (x : ℕ) : term :=
  match x with
  | 0 := a
  | (x + 1) := x
  end in
substs σ

parameters (S : set C) (A : set (C × C)) (R : set (C × C × C))
parameters [decidable_pred S] [decidable_pred A] [decidable_pred R]

parameter hA : ∀ {c s}, (c, s) ∈ A → s ∈ S
parameter hR₁ : ∀ {s₁ s₂ s₃}, (s₁, s₂, s₃) ∈ R → s₁ ∈ S
parameter hR₂ : ∀ {s₁ s₂ s₃}, (s₁, s₂, s₃) ∈ R → s₂ ∈ S
parameter hR₃ : ∀ {s₁ s₂ s₃}, (s₁, s₂, s₃) ∈ R → s₃ ∈ S

abbreviation context : Type := list term

inductive entails₁ : context → term → term → Prop
| ax₁ {c s} : (c, s) ∈ A → entails₁ [] ↑c ↑s
| start {Γ A s} : s ∈ S → entails₁ Γ A ↑s → entails₁ (A :: Γ) ↑0 A
| weak {Γ A B C s} : s ∈ S → entails₁ Γ A B → entails₁ Γ C ↑s → entails₁ (C :: Γ) (subst.weak A) (subst.weak B)
| pi {Γ A B s₁ s₂ s₃} : (s₁, s₂, s₃) ∈ R → entails₁ Γ A ↑s₁ → entails₁ (A :: Γ) B ↑s₂ → entails₁ Γ (term.pi A B) ↑s₃
| app {Γ f A B a} : entails₁ Γ f (term.pi A B) → entails₁ Γ a A → entails₁ Γ (term.app f a) (subst a B)
| lam {Γ A b B s} : s ∈ S → entails₁ (A :: Γ) b B → entails₁ Γ (term.pi A B) ↑s → entails₁ Γ (term.lam A b) (term.pi A B)

inductive ctx₁ : context → Prop
| empty : ctx₁ []
| ext {Γ A s} : s ∈ S → entails₁ Γ A ↑s → ctx₁ (A :: Γ)

set_option class.instance_max_depth 5
set_option trace.class_instances true
lemma ctx₁_of_entails₁ {Γ A B} : entails₁ Γ A B → ctx₁ Γ :=
begin
  sorry
end

-- This lemma is not true because `Γ` can be literally anything, including an
-- invalid context.
lemma entails₁.ax₂ {Γ c s} : (c, s) ∈ A → entails₁ Γ ↑c ↑s :=
begin
  intro h,
  induction Γ with B Γ ih,
  { exact entails₁.ax₁ h },
  { refine entails₁.weak _ ih _,
    sorry
  }
end

end


/- More tactics -/

example (p q : Nat → Prop) : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x := by
  intro h
  cases h with
  | intro x hpq =>
    cases hpq with
    | intro hp hq =>
      exists x

example : p ∧ q → q ∧ p := by
  intro p
  cases p
  constructor <;> assumption

example : p ∧ ¬ p → q := by
  intro h
  cases h
  contradiction


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

universes u v

namespace Mathlib

namespace rbnode

@[simp] theorem balance1_eq₁ {α : Type u} (l : rbnode α) (x : α) (r₁ : rbnode α) (y : α)
    (r₂ : rbnode α) (v : α) (t : rbnode α) :
    balance1 (red_node l x r₁) y r₂ v t = red_node (black_node l x r₁) y (black_node r₂ v t) :=
  sorry

@[simp] theorem balance1_eq₂ {α : Type u} (l₁ : rbnode α) (y : α) (l₂ : rbnode α) (x : α)
    (r : rbnode α) (v : α) (t : rbnode α) :
    get_color l₁ ≠ color.red →
        balance1 l₁ y (red_node l₂ x r) v t = red_node (black_node l₁ y l₂) x (black_node r v t) :=
  sorry

@[simp] theorem balance1_eq₃ {α : Type u} (l : rbnode α) (y : α) (r : rbnode α) (v : α)
    (t : rbnode α) :
    get_color l ≠ color.red →
        get_color r ≠ color.red → balance1 l y r v t = black_node (red_node l y r) v t :=
  sorry

@[simp] theorem balance2_eq₁ {α : Type u} (l : rbnode α) (x₁ : α) (r₁ : rbnode α) (y : α)
    (r₂ : rbnode α) (v : α) (t : rbnode α) :
    balance2 (red_node l x₁ r₁) y r₂ v t = red_node (black_node t v l) x₁ (black_node r₁ y r₂) :=
  sorry

@[simp] theorem balance2_eq₂ {α : Type u} (l₁ : rbnode α) (y : α) (l₂ : rbnode α) (x₂ : α)
    (r₂ : rbnode α) (v : α) (t : rbnode α) :
    get_color l₁ ≠ color.red →
        balance2 l₁ y (red_node l₂ x₂ r₂) v t =
          red_node (black_node t v l₁) y (black_node l₂ x₂ r₂) :=
  sorry

@[simp] theorem balance2_eq₃ {α : Type u} (l : rbnode α) (y : α) (r : rbnode α) (v : α)
    (t : rbnode α) :
    get_color l ≠ color.red →
        get_color r ≠ color.red → balance2 l y r v t = black_node t v (red_node l y r) :=
  sorry

/- We can use the same induction principle for balance1 and balance2 -/

theorem balance.cases {α : Type u} {p : rbnode α → α → rbnode α → Prop} (l : rbnode α) (y : α)
    (r : rbnode α)
    (red_left :
      ∀ (l : rbnode α) (x : α) (r₁ : rbnode α) (y : α) (r₂ : rbnode α), p (red_node l x r₁) y r₂)
    (red_right :
      ∀ (l₁ : rbnode α) (y : α) (l₂ : rbnode α) (x : α) (r : rbnode α),
        get_color l₁ ≠ color.red → p l₁ y (red_node l₂ x r))
    (other :
      ∀ (l : rbnode α) (y : α) (r : rbnode α),
        get_color l ≠ color.red → get_color r ≠ color.red → p l y r) :
    p l y r :=
  sorry

theorem balance1_ne_leaf {α : Type u} (l : rbnode α) (x : α) (r : rbnode α) (v : α) (t : rbnode α) :
    balance1 l x r v t ≠ leaf :=
  sorry

theorem balance1_node_ne_leaf {α : Type u} {s : rbnode α} (a : α) (t : rbnode α) :
    s ≠ leaf → balance1_node s a t ≠ leaf :=
  sorry

theorem balance2_ne_leaf {α : Type u} (l : rbnode α) (x : α) (r : rbnode α) (v : α) (t : rbnode α) :
    balance2 l x r v t ≠ leaf :=
  sorry

theorem balance2_node_ne_leaf {α : Type u} {s : rbnode α} (a : α) (t : rbnode α) :
    s ≠ leaf → balance2_node s a t ≠ leaf :=
  sorry

theorem ins.induction {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {p : rbnode α → Prop}
    (t : rbnode α) (x : α) (is_leaf : p leaf)
    (is_red_lt :
      ∀ (a : rbnode α) (y : α) (b : rbnode α),
        cmp_using lt x y = ordering.lt → p a → p (red_node a y b))
    (is_red_eq :
      ∀ (a : rbnode α) (y : α) (b : rbnode α), cmp_using lt x y = ordering.eq → p (red_node a y b))
    (is_red_gt :
      ∀ (a : rbnode α) (y : α) (b : rbnode α),
        cmp_using lt x y = ordering.gt → p b → p (red_node a y b))
    (is_black_lt_red :
      ∀ (a : rbnode α) (y : α) (b : rbnode α),
        cmp_using lt x y = ordering.lt → get_color a = color.red → p a → p (black_node a y b))
    (is_black_lt_not_red :
      ∀ (a : rbnode α) (y : α) (b : rbnode α),
        cmp_using lt x y = ordering.lt → get_color a ≠ color.red → p a → p (black_node a y b))
    (is_black_eq :
      ∀ (a : rbnode α) (y : α) (b : rbnode α),
        cmp_using lt x y = ordering.eq → p (black_node a y b))
    (is_black_gt_red :
      ∀ (a : rbnode α) (y : α) (b : rbnode α),
        cmp_using lt x y = ordering.gt → get_color b = color.red → p b → p (black_node a y b))
    (is_black_gt_not_red :
      ∀ (a : rbnode α) (y : α) (b : rbnode α),
        cmp_using lt x y = ordering.gt → get_color b ≠ color.red → p b → p (black_node a y b)) :
    p t :=
  sorry

theorem is_searchable_balance1 {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {l : rbnode α}
    {y : α} {r : rbnode α} {v : α} {t : rbnode α} {lo : Option α} {hi : Option α} :
    is_searchable lt l lo (some y) →
        is_searchable lt r (some y) (some v) →
          is_searchable lt t (some v) hi → is_searchable lt (balance1 l y r v t) lo hi :=
  sorry

theorem is_searchable_balance1_node {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    {t : rbnode α} [is_trans α lt] {y : α} {s : rbnode α} {lo : Option α} {hi : Option α} :
    is_searchable lt t lo (some y) →
        is_searchable lt s (some y) hi → is_searchable lt (balance1_node t y s) lo hi :=
  sorry

theorem is_searchable_balance2 {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {l : rbnode α}
    {y : α} {r : rbnode α} {v : α} {t : rbnode α} {lo : Option α} {hi : Option α} :
    is_searchable lt t lo (some v) →
        is_searchable lt l (some v) (some y) →
          is_searchable lt r (some y) hi → is_searchable lt (balance2 l y r v t) lo hi :=
  sorry

theorem is_searchable_balance2_node {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    {t : rbnode α} [is_trans α lt] {y : α} {s : rbnode α} {lo : Option α} {hi : Option α} :
    is_searchable lt s lo (some y) →
        is_searchable lt t (some y) hi → is_searchable lt (balance2_node t y s) lo hi :=
  sorry

theorem is_searchable_ins {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {t : rbnode α} {x : α}
    [is_strict_weak_order α lt] {lo : Option α} {hi : Option α} (h : is_searchable lt t lo hi) :
    lift lt lo (some x) → lift lt (some x) hi → is_searchable lt (ins lt t x) lo hi :=
  sorry

theorem is_searchable_mk_insert_result {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    {c : color} {t : rbnode α} :
    is_searchable lt t none none → is_searchable lt (mk_insert_result c t) none none :=
  sorry

theorem is_searchable_insert {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {t : rbnode α}
    {x : α} [is_strict_weak_order α lt] :
    is_searchable lt t none none → is_searchable lt (insert lt t x) none none :=
  sorry

end rbnode

namespace rbnode

theorem mem_balance1_node_of_mem_left {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {x : α}
    {s : rbnode α} (v : α) (t : rbnode α) : mem lt x s → mem lt x (balance1_node s v t) :=
  sorry

theorem mem_balance2_node_of_mem_left {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {x : α}
    {s : rbnode α} (v : α) (t : rbnode α) : mem lt x s → mem lt x (balance2_node s v t) :=
  sorry

theorem mem_balance1_node_of_mem_right {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {x : α}
    {t : rbnode α} (v : α) (s : rbnode α) : mem lt x t → mem lt x (balance1_node s v t) :=
  sorry

theorem mem_balance2_node_of_mem_right {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {x : α}
    {t : rbnode α} (v : α) (s : rbnode α) : mem lt x t → mem lt x (balance2_node s v t) :=
  sorry

theorem mem_balance1_node_of_incomp {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {x : α}
    {v : α} (s : rbnode α) (t : rbnode α) :
    ¬lt x v ∧ ¬lt v x → s ≠ leaf → mem lt x (balance1_node s v t) :=
  sorry

theorem mem_balance2_node_of_incomp {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {x : α}
    {v : α} (s : rbnode α) (t : rbnode α) :
    ¬lt v x ∧ ¬lt x v → s ≠ leaf → mem lt x (balance2_node s v t) :=
  sorry

theorem ins_ne_leaf {α : Type u} (lt : α → α → Prop) [DecidableRel lt] (t : rbnode α) (x : α) :
    ins lt t x ≠ leaf :=
  sorry

theorem insert_ne_leaf {α : Type u} (lt : α → α → Prop) [DecidableRel lt] (t : rbnode α) (x : α) :
    insert lt t x ≠ leaf :=
  sorry

theorem mem_ins_of_incomp {α : Type u} (lt : α → α → Prop) [DecidableRel lt] (t : rbnode α) {x : α}
    {y : α} (h : ¬lt x y ∧ ¬lt y x) : mem lt x (ins lt t y) :=
  sorry

theorem mem_ins_of_mem {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {t : rbnode α} (z : α) {x : α} (h : mem lt x t) :
    mem lt x (ins lt t z) :=
  sorry

theorem mem_mk_insert_result {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {a : α}
    {t : rbnode α} (c : color) : mem lt a t → mem lt a (mk_insert_result c t) :=
  sorry

theorem mem_of_mem_mk_insert_result {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {a : α}
    {t : rbnode α} {c : color} : mem lt a (mk_insert_result c t) → mem lt a t :=
  sorry

theorem mem_insert_of_incomp {α : Type u} (lt : α → α → Prop) [DecidableRel lt] (t : rbnode α)
    {x : α} {y : α} (h : ¬lt x y ∧ ¬lt y x) : mem lt x (insert lt t y) :=
  sorry

theorem mem_insert_of_mem {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {t : rbnode α} {x : α} (z : α) :
    mem lt x t → mem lt x (insert lt t z) :=
  fun (ᾰ : mem lt x t) => mem_mk_insert_result lt (get_color t) (mem_ins_of_mem lt z ᾰ)

theorem of_mem_balance1_node {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {x : α} {s : rbnode α} {v : α} {t : rbnode α} :
    mem lt x (balance1_node s v t) → mem lt x s ∨ ¬lt x v ∧ ¬lt v x ∨ mem lt x t :=
  sorry

theorem of_mem_balance2_node {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {x : α} {s : rbnode α} {v : α} {t : rbnode α} :
    mem lt x (balance2_node s v t) → mem lt x s ∨ ¬lt x v ∧ ¬lt v x ∨ mem lt x t :=
  sorry

theorem equiv_or_mem_of_mem_ins {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {t : rbnode α} {x : α} {z : α} (h : mem lt x (ins lt t z)) :
    strict_weak_order.equiv x z ∨ mem lt x t :=
  sorry

theorem equiv_or_mem_of_mem_insert {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {t : rbnode α} {x : α} {z : α} (h : mem lt x (insert lt t z)) :
    strict_weak_order.equiv x z ∨ mem lt x t :=
  sorry

theorem mem_exact_balance1_node_of_mem_exact {α : Type u} {x : α} {s : rbnode α} (v : α)
    (t : rbnode α) : mem_exact x s → mem_exact x (balance1_node s v t) :=
  sorry

theorem mem_exact_balance2_node_of_mem_exact {α : Type u} {x : α} {s : rbnode α} (v : α)
    (t : rbnode α) : mem_exact x s → mem_exact x (balance2_node s v t) :=
  sorry

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

theorem find_balance2_node {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {x : α} {y : α} {z : α} {s : rbnode α} {t : rbnode α}
    [is_trans α lt] {lo : Option α} {hi : Option α} :
    is_searchable lt s lo (some z) →
        is_searchable lt t (some z) hi →
          find lt t y = some x →
            strict_weak_order.equiv y x → find lt (balance2_node t z s) y = some x :=
  sorry

/- Auxiliary lemma -/

theorem ite_eq_of_not_lt {α : Type u} (lt : α → α → Prop) [DecidableRel lt] [is_strict_order α lt]
    {a : α} {b : α} {β : Type v} (t : β) (s : β) (h : lt b a) : ite (lt a b) t s = s :=
  sorry

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

theorem find_mk_insert_result {α : Type u} (lt : α → α → Prop) [DecidableRel lt] (c : color)
    (t : rbnode α) (x : α) : find lt (mk_insert_result c t) x = find lt t x :=
  sorry

theorem find_insert_of_eqv {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {x : α} {y : α} {t : rbnode α} (he : strict_weak_order.equiv x y) :
    is_searchable lt t none none → find lt (insert lt t x) y = some x :=
  sorry

theorem weak_trichotomous {α : Type u} (lt : α → α → Prop) [DecidableRel lt] (x : α) (y : α)
    {p : Prop} (is_lt : lt x y → p) (is_eqv : ¬lt x y ∧ ¬lt y x → p) (is_gt : lt y x → p) : p :=
  dite (lt x y)
    (fun (h : lt x y) =>
      dite (lt y x) (fun (h_1 : lt y x) => is_lt h) fun (h_1 : ¬lt y x) => is_lt h)
    fun (h : ¬lt x y) =>
      dite (lt y x) (fun (h : lt y x) => is_gt h)
        fun (h_1 : ¬lt y x) => is_eqv { left := h, right := h_1 }

theorem find_black_eq_find_red {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {l : rbnode α}
    {y : α} {r : rbnode α} {x : α} : find lt (black_node l y r) x = find lt (red_node l y r) x :=
  sorry

theorem find_red_of_lt {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {l : rbnode α} {y : α}
    {r : rbnode α} {x : α} (h : lt x y) : find lt (red_node l y r) x = find lt l x :=
  sorry

theorem find_red_of_gt {α : Type u} (lt : α → α → Prop) [DecidableRel lt] [is_strict_order α lt]
    {l : rbnode α} {y : α} {r : rbnode α} {x : α} (h : lt y x) :
    find lt (red_node l y r) x = find lt r x :=
  sorry

theorem find_red_of_incomp {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {l : rbnode α} {y : α}
    {r : rbnode α} {x : α} (h : ¬lt x y ∧ ¬lt y x) : find lt (red_node l y r) x = some y :=
  sorry

theorem find_balance1_lt {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {l : rbnode α} {r : rbnode α} {t : rbnode α} {v : α} {x : α} {y : α}
    {lo : Option α} {hi : Option α} (h : lt x y) (hl : is_searchable lt l lo (some v))
    (hr : is_searchable lt r (some v) (some y)) (ht : is_searchable lt t (some y) hi) :
    find lt (balance1 l v r y t) x = find lt (red_node l v r) x :=
  sorry

theorem find_balance1_node_lt {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {t : rbnode α} {s : rbnode α} {x : α} {y : α} {lo : Option α}
    {hi : Option α} (hlt : lt y x) (ht : is_searchable lt t lo (some x))
    (hs : is_searchable lt s (some x) hi)
    (hne :
      autoParam (t ≠ leaf)
        (Lean.Syntax.ident Lean.SourceInfo.none
          (String.toSubstring "Mathlib.rbnode.ins_ne_leaf_tac")
          (Lean.Name.mkStr
            (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "rbnode")
            "ins_ne_leaf_tac")
          [])) :
    find lt (balance1_node t x s) y = find lt t y :=
  sorry

theorem find_balance1_gt {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {l : rbnode α} {r : rbnode α} {t : rbnode α} {v : α} {x : α} {y : α}
    {lo : Option α} {hi : Option α} (h : lt y x) (hl : is_searchable lt l lo (some v))
    (hr : is_searchable lt r (some v) (some y)) (ht : is_searchable lt t (some y) hi) :
    find lt (balance1 l v r y t) x = find lt t x :=
  sorry

theorem find_balance1_node_gt {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {t : rbnode α} {s : rbnode α} {x : α} {y : α} {lo : Option α}
    {hi : Option α} (h : lt x y) (ht : is_searchable lt t lo (some x))
    (hs : is_searchable lt s (some x) hi)
    (hne :
      autoParam (t ≠ leaf)
        (Lean.Syntax.ident Lean.SourceInfo.none
          (String.toSubstring "Mathlib.rbnode.ins_ne_leaf_tac")
          (Lean.Name.mkStr
            (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "rbnode")
            "ins_ne_leaf_tac")
          [])) :
    find lt (balance1_node t x s) y = find lt s y :=
  sorry

theorem find_balance1_eqv {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {l : rbnode α} {r : rbnode α} {t : rbnode α} {v : α} {x : α} {y : α}
    {lo : Option α} {hi : Option α} (h : ¬lt x y ∧ ¬lt y x) (hl : is_searchable lt l lo (some v))
    (hr : is_searchable lt r (some v) (some y)) (ht : is_searchable lt t (some y) hi) :
    find lt (balance1 l v r y t) x = some y :=
  sorry

theorem find_balance1_node_eqv {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {t : rbnode α} {s : rbnode α} {x : α} {y : α} {lo : Option α}
    {hi : Option α} (h : ¬lt x y ∧ ¬lt y x) (ht : is_searchable lt t lo (some y))
    (hs : is_searchable lt s (some y) hi)
    (hne :
      autoParam (t ≠ leaf)
        (Lean.Syntax.ident Lean.SourceInfo.none
          (String.toSubstring "Mathlib.rbnode.ins_ne_leaf_tac")
          (Lean.Name.mkStr
            (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "rbnode")
            "ins_ne_leaf_tac")
          [])) :
    find lt (balance1_node t y s) x = some y :=
  sorry

theorem find_balance2_lt {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {l : rbnode α} {v : α} {r : rbnode α} {t : rbnode α} {x : α} {y : α}
    {lo : Option α} {hi : Option α} (h : lt x y) (hl : is_searchable lt l (some y) (some v))
    (hr : is_searchable lt r (some v) hi) (ht : is_searchable lt t lo (some y)) :
    find lt (balance2 l v r y t) x = find lt t x :=
  sorry

theorem find_balance2_node_lt {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {s : rbnode α} {t : rbnode α} {x : α} {y : α} {lo : Option α}
    {hi : Option α} (h : lt x y) (ht : is_searchable lt t (some y) hi)
    (hs : is_searchable lt s lo (some y))
    (hne :
      autoParam (t ≠ leaf)
        (Lean.Syntax.ident Lean.SourceInfo.none
          (String.toSubstring "Mathlib.rbnode.ins_ne_leaf_tac")
          (Lean.Name.mkStr
            (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "rbnode")
            "ins_ne_leaf_tac")
          [])) :
    find lt (balance2_node t y s) x = find lt s x :=
  sorry

theorem find_balance2_gt {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {l : rbnode α} {v : α} {r : rbnode α} {t : rbnode α} {x : α} {y : α}
    {lo : Option α} {hi : Option α} (h : lt y x) (hl : is_searchable lt l (some y) (some v))
    (hr : is_searchable lt r (some v) hi) (ht : is_searchable lt t lo (some y)) :
    find lt (balance2 l v r y t) x = find lt (red_node l v r) x :=
  sorry

theorem find_balance2_node_gt {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {s : rbnode α} {t : rbnode α} {x : α} {y : α} {lo : Option α}
    {hi : Option α} (h : lt y x) (ht : is_searchable lt t (some y) hi)
    (hs : is_searchable lt s lo (some y))
    (hne :
      autoParam (t ≠ leaf)
        (Lean.Syntax.ident Lean.SourceInfo.none
          (String.toSubstring "Mathlib.rbnode.ins_ne_leaf_tac")
          (Lean.Name.mkStr
            (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "rbnode")
            "ins_ne_leaf_tac")
          [])) :
    find lt (balance2_node t y s) x = find lt t x :=
  sorry

theorem find_balance2_eqv {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {l : rbnode α} {v : α} {r : rbnode α} {t : rbnode α} {x : α} {y : α}
    {lo : Option α} {hi : Option α} (h : ¬lt x y ∧ ¬lt y x)
    (hl : is_searchable lt l (some y) (some v)) (hr : is_searchable lt r (some v) hi)
    (ht : is_searchable lt t lo (some y)) : find lt (balance2 l v r y t) x = some y :=
  sorry

theorem find_balance2_node_eqv {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {t : rbnode α} {s : rbnode α} {x : α} {y : α} {lo : Option α}
    {hi : Option α} (h : ¬lt x y ∧ ¬lt y x) (ht : is_searchable lt t (some y) hi)
    (hs : is_searchable lt s lo (some y))
    (hne :
      autoParam (t ≠ leaf)
        (Lean.Syntax.ident Lean.SourceInfo.none
          (String.toSubstring "Mathlib.rbnode.ins_ne_leaf_tac")
          (Lean.Name.mkStr
            (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "rbnode")
            "ins_ne_leaf_tac")
          [])) :
    find lt (balance2_node t y s) x = some y :=
  sorry

theorem find_ins_of_disj {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {x : α} {y : α} {t : rbnode α} (hn : lt x y ∨ lt y x)
    {lo : Option α} {hi : Option α} (hs : is_searchable lt t lo hi) (hlt₁ : lift lt lo (some x))
    (hlt₂ : lift lt (some x) hi) : find lt (ins lt t x) y = find lt t y :=
  sorry

theorem find_insert_of_disj {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {x : α} {y : α} {t : rbnode α} (hd : lt x y ∨ lt y x) :
    is_searchable lt t none none → find lt (insert lt t x) y = find lt t y :=
  sorry

theorem find_insert_of_not_eqv {α : Type u} (lt : α → α → Prop) [DecidableRel lt]
    [is_strict_weak_order α lt] {x : α} {y : α} {t : rbnode α} (hn : ¬strict_weak_order.equiv x y) :
    is_searchable lt t none none → find lt (insert lt t x) y = find lt t y :=
  sorry

inductive is_bad_red_black {α : Type u} : rbnode α → ℕ → Prop where
| bad_red :
    ∀ {c₁ c₂ : color} {n : ℕ} {l r : rbnode α} {v : α},
      is_red_black l c₁ n → is_red_black r c₂ n → is_bad_red_black (red_node l v r) n

theorem balance1_rb {α : Type u} {l : rbnode α} {r : rbnode α} {t : rbnode α} {y : α} {v : α}
    {c_l : color} {c_r : color} {c_t : color} {n : ℕ} :
    is_red_black l c_l n →
        is_red_black r c_r n →
          is_red_black t c_t n → ∃ (c : color), is_red_black (balance1 l y r v t) c (Nat.succ n) :=
  sorry

theorem balance2_rb {α : Type u} {l : rbnode α} {r : rbnode α} {t : rbnode α} {y : α} {v : α}
    {c_l : color} {c_r : color} {c_t : color} {n : ℕ} :
    is_red_black l c_l n →
        is_red_black r c_r n →
          is_red_black t c_t n → ∃ (c : color), is_red_black (balance2 l y r v t) c (Nat.succ n) :=
  sorry

theorem balance1_node_rb {α : Type u} {t : rbnode α} {s : rbnode α} {y : α} {c : color} {n : ℕ} :
    is_bad_red_black t n →
        is_red_black s c n → ∃ (c : color), is_red_black (balance1_node t y s) c (Nat.succ n) :=
  sorry

theorem balance2_node_rb {α : Type u} {t : rbnode α} {s : rbnode α} {y : α} {c : color} {n : ℕ} :
    is_bad_red_black t n →
        is_red_black s c n → ∃ (c : color), is_red_black (balance2_node t y s) c (Nat.succ n) :=
  sorry

def ins_rb_result {α : Type u} : rbnode α → color → ℕ → Prop := sorry

theorem of_get_color_eq_red {α : Type u} {t : rbnode α} {c : color} {n : ℕ} :
    get_color t = color.red → is_red_black t c n → c = color.red :=
  sorry

theorem of_get_color_ne_red {α : Type u} {t : rbnode α} {c : color} {n : ℕ} :
    get_color t ≠ color.red → is_red_black t c n → c = color.black :=
  sorry

theorem ins_rb {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {t : rbnode α} (x : α) {c : color}
    {n : ℕ} (h : is_red_black t c n) : ins_rb_result (ins lt t x) c n :=
  sorry

def insert_rb_result {α : Type u} : rbnode α → color → ℕ → Prop := sorry

theorem insert_rb {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {t : rbnode α} (x : α)
    {c : color} {n : ℕ} (h : is_red_black t c n) : insert_rb_result (insert lt t x) c n :=
  sorry

theorem insert_is_red_black {α : Type u} (lt : α → α → Prop) [DecidableRel lt] {t : rbnode α}
    {c : color} {n : ℕ} (x : α) :
    is_red_black t c n → ∃ (c : color), ∃ (n : ℕ), is_red_black (insert lt t x) c n :=
  sorry

end Mathlib