lean4-htt/tests/elab/issue6592.lean
Garmelon 08eb78a5b2
chore: switch to new test/bench suite (#12590)
This PR sets up the new integrated test/bench suite. It then migrates
all benchmarks and some related tests to the new suite. There's also
some documentation and some linting.

For now, a lot of the old tests are left alone so this PR doesn't become
even larger than it already is. Eventually, all tests should be migrated
to the new suite though so there isn't a confusing mix of two systems.
2026-02-25 13:51:53 +00:00

136 lines
6.4 KiB
Text
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/--
Colors of red black tree nodes.
-/
inductive Color where
| black
| red
/--
The basic red black tree data structure without any invariant etc. attached.
-/
inductive Raw (α : Type u) where
/--
The empty tree.
-/
| nil : Raw α
/--
A node with left and right successor, its color and a piece of data
-/
| node (left : Raw α) (data : α) (color : Color) (right : Raw α) : Raw α
namespace Raw
/--
Paint the color of the root of `t` to given color `c`.
-/
@[inline]
def paintColor (c : Color) (t : Raw α) : Raw α :=
match t with
| .nil => .nil
| .node l d _ r => .node l d c r
-- Balanced insert into the left child, fixing red on red sequences on the way.
@[inline]
def baliL (d : α) : Raw α → Raw α → Raw α
| .node (.node t₁ data₁ .red t₂) data₂ .red t₃, right
| .node t₁ data₁ .red (.node t₂ data₂ .red t₃), right =>
.node (.node t₁ data₁ .black t₂) data₂ .red (.node t₃ d .black right)
| left, right => .node left d .black right
-- Balanced insert into the right child, fixing red on red sequences on the way.
@[inline]
def baliR (d : α) : Raw α → Raw α → Raw α
| left, .node t₁ data₁ .red (.node t₂ data₂ .red t₃)
| left, .node (.node t₁ data₁ .red t₂) data₂ .red t₃ =>
.node (.node left d .black t₁) data₁ .red (.node t₂ data₂ .black t₃)
| left, right => .node left d .black right
-- Balance a tree on the way up from deletion, prioritizing the left side.
def baldL (d : α) : Raw α → Raw α → Raw α
| .node t₁ data .red t₂, right =>
.node (.node t₁ data .black t₂) d .red right
| left, .node t₁ data .black t₂ =>
baliR d left (.node t₁ data .red t₂)
| left, .node (.node t₁ data₁ .black t₂) data₂ .red t₃ =>
.node (.node left d .black t₁) data₁ .red (baliR data₂ t₂ (paintColor .red t₃))
| left, right => .node left d .red right
-- Balance a tree on the way up from deletion, prioritizing the right side.
def baldR (d : α) : Raw α → Raw α → Raw α
| left, .node t₁ data .red t₂ =>
.node left d .red (.node t₁ data .black t₂)
| .node t₁ data .black t₂, right =>
baliL d (.node t₁ data .red t₂) right
| .node t₁ data₁ .red (.node t₂ data₂ .black t₃), right =>
.node (baliL data₁ (paintColor .red t₁) t₂) data₁ .red (.node t₃ data₂ .black right)
| left, right => .node left d .red right
-- Appends one tree to another while painting the correct color
def appendTrees : Raw α → Raw α → Raw α
| .nil, t => t
| t, .nil => t
| .node left₁ data₁ .red right₁, .node left₂ data₂ .red right₂ =>
match appendTrees right₁ left₂ with
| .node left₃ data₃ .red right₃ =>
.node (.node left₁ data₁ .red left₃) data₃ .red (.node right₃ data₂ .red right₂)
| t => .node left₁ data₁ .red (.node t data₂ .red right₂)
| .node left₁ data₁ .black right₁, .node left₂ data₂ .black right₂ =>
match appendTrees right₁ left₂ with
| .node left₃ data₃ .red right₃ =>
.node (node left₁ data₁ .black left₃) data₃ .red (node right₃ data₂ .black right₂)
| t => baldL data₁ left₁ (node t data₂ .black right₂)
| t, .node left data .red right => node (appendTrees t left) data .red right
| .node left data .red right, t => .node left data .red (appendTrees right t)
def del [Ord α] (d : α) : Raw α → Raw α
| .nil => .nil
| .node left data _ right =>
match compare d data with
| .lt =>
match left with
| .node _ _ .black _ => baldL data (del d left) right
| _ => .node (del d left) data .red right
| .eq => appendTrees left right
| .gt =>
match right with
| .node _ _ .black _ => baldR data left (del d right)
| _ => .node left data .red (del d right)
/--
info: equations:
@[defeq] theorem Raw.del.eq_1.{u_1} : ∀ {α : Type u_1} [inst : Ord α] (d : α), del d nil = nil
@[defeq] theorem Raw.del.eq_2.{u_1} : ∀ {α : Type u_1} [inst : Ord α] (d d_1 : α) (color : Color) (left_1 : Raw α)
(data : α) (right left_3 : Raw α) (data_1 : α) (right_1 : Raw α),
del d ((left_1.node data Color.black right).node d_1 color (left_3.node data_1 Color.black right_1)) =
match compare d d_1 with
| Ordering.lt => baldL d_1 (del d (left_1.node data Color.black right)) (left_3.node data_1 Color.black right_1)
| Ordering.eq => (left_1.node data Color.black right).appendTrees (left_3.node data_1 Color.black right_1)
| Ordering.gt => baldR d_1 (left_1.node data Color.black right) (del d (left_3.node data_1 Color.black right_1))
theorem Raw.del.eq_3.{u_1} : ∀ {α : Type u_1} [inst : Ord α] (d d_1 : α) (color : Color) (r left_1 : Raw α) (data : α)
(right : Raw α),
(∀ (left : Raw α) (data : α) (right : Raw α), r = left.node data Color.black right → False) →
del d ((left_1.node data Color.black right).node d_1 color r) =
match compare d d_1 with
| Ordering.lt => baldL d_1 (del d (left_1.node data Color.black right)) r
| Ordering.eq => (left_1.node data Color.black right).appendTrees r
| Ordering.gt => (left_1.node data Color.black right).node d_1 Color.red (del d r)
theorem Raw.del.eq_4.{u_1} : ∀ {α : Type u_1} [inst : Ord α] (d : α) (l : Raw α) (d_1 : α) (color : Color)
(left_2 : Raw α) (data : α) (right : Raw α),
(∀ (left : Raw α) (data : α) (right : Raw α), l = left.node data Color.black right → False) →
del d (l.node d_1 color (left_2.node data Color.black right)) =
match compare d d_1 with
| Ordering.lt => (del d l).node d_1 Color.red (left_2.node data Color.black right)
| Ordering.eq => l.appendTrees (left_2.node data Color.black right)
| Ordering.gt => baldR d_1 l (del d (left_2.node data Color.black right))
theorem Raw.del.eq_5.{u_1} : ∀ {α : Type u_1} [inst : Ord α] (d : α) (l : Raw α) (d_1 : α) (color : Color) (r : Raw α),
(∀ (left : Raw α) (data : α) (right : Raw α), l = left.node data Color.black right → False) →
(∀ (left : Raw α) (data : α) (right : Raw α), r = left.node data Color.black right → False) →
del d (l.node d_1 color r) =
match compare d d_1 with
| Ordering.lt => (del d l).node d_1 Color.red r
| Ordering.eq => l.appendTrees r
| Ordering.gt => l.node d_1 Color.red (del d r)
-/
#guard_msgs in
#print equations del