Friendpaste

--- Revision None
+++ Revision 343838643963
@@ -0,0 +1,98 @@
+20:49 ~/g/code/p6/t$ cat Tree/LLRB.pm6 
+class Tree::LLRB {
+        class Node {
+                has $.key is rw;
+                has $.val is rw;
+                has Node $.left is rw;
+                has Node $.right is rw;
+                has $.color is rw;
+
+                method new($key, $val) {
+                        $.key = $key;
+                        $.val = $val;
+                        # True == Red, False == Black
+                        $.color = True;
+                }
+
+                method colorFlip() {
+                        $.color = !$.color;
+                        $.left.color = !$.left.color if $.left;
+                        $.right.color = !$.right.color if $.right;
+                }
+        }
+
+        sub isRed(Node $h) {
+                $h and $h.color;
+        }
+
+        sub rotateLeft(Node $h) {
+                my $x = $h.right;
+                $h.right = $x.left;
+                $x.left = $h;
+                $x.color = $h.color;
+                $h.color = True;
+                return $x;
+        }
+
+        sub rotateRight(Node $h) {
+                my $x = $h.left;
+                $h.left = $x.right;
+                $x.right = $h;
+                $x.color = $h.color;
+                $h.color = True;
+                return $x;
+        }
+
+
+        has Node $!root;
+
+
+        method insert($key, $val) {
+                $!root = insert_at_node($!root, $key, $val);
+                $!root.color = 'BLACK';
+                return self;
+        }
+
+        sub insert_at_node($h, $key, $val) {
+                return Node.new($key, $val) unless $h;
+
+                $h.colorFlip()
+                        if isRed($h.left) and isRed($h.right);
+
+                given $key cmp $h.key {
+                        when  0 { $h.val = $val; }  # Update in place
+                        when -1 { $h.left = insert_at_node($h.left, $key, $val); }
+                        when  1 { $h.right = insert_at_node($h.right, $key, $val); }
+                }
+
+                $h = rotateLeft($h)
+                        if isRed($h.right) and not isRed($h.left);
+                $h = rotateRight($h)
+                        if isRed($h.left) and isRed($h.left.left);
+
+                return $h;
+        }
+
+        method dump() {
+                dump_node($!root, 0, 'ROOT');
+        }
+
+        sub dump_node($h, $indent, $label) {
+                print '  ' x $indent, "$label:".fmt('%6s'), ' ';
+                if !$h {
+                        say '  ' x $indent, "LEAF";
+                }
+                else {
+                        say '  ' x $indent, "$h.key => $h.val";
+                        dump_node($h.left, $indent + 1, 'Left');
+                        dump_node($h.right, $indent + 1, 'Right');
+                }
+        }
+}
+20:49 ~/g/code/p6/t$ perl6 -e 'use Tree::LLRB; Tree::LLRB.new().insert(1, True).dump()'
+Type objects are abstract and have no attributes, but you tried to access $!key
+  in 'Node::new' at line 10:Tree/LLRB.pm6
+  in 'Tree::LLRB::insert_at_node' at line 56:Tree/LLRB.pm6
+  in 'Tree::LLRB::insert' at line 50:Tree/LLRB.pm6
+  in main program body at line 1
+
a	b
	0	+	20:49 ~/g/code/p6/t$ cat Tree/LLRB.pm6
	0	+	class Tree::LLRB {
	0	+	class Node {
	0	+	has $.key is rw;
	0	+	has $.val is rw;
	0	+	has Node $.left is rw;
	0	+	has Node $.right is rw;
	0	+	has $.color is rw;
	0	+
	0	+	method new($key, $val) {
	0	+	$.key = $key;
	0	+	$.val = $val;
	0	+	# True == Red, False == Black
	0	+	$.color = True;
	0	+	}
	0	+
	0	+	method colorFlip() {
	0	+	$.color = !$.color;
	0	+	$.left.color = !$.left.color if $.left;
	0	+	$.right.color = !$.right.color if $.right;
	0	+	}
	0	+	}
	0	+
	0	+	sub isRed(Node $h) {
	0	+	$h and $h.color;
	0	+	}
	0	+
	0	+	sub rotateLeft(Node $h) {
	0	+	my $x = $h.right;
	0	+	$h.right = $x.left;
	0	+	$x.left = $h;
	0	+	$x.color = $h.color;
	0	+	$h.color = True;
	0	+	return $x;
	0	+	}
	0	+
	0	+	sub rotateRight(Node $h) {
	0	+	my $x = $h.left;
	0	+	$h.left = $x.right;
	0	+	$x.right = $h;
	0	+	$x.color = $h.color;
	0	+	$h.color = True;
	0	+	return $x;
	0	+	}
	0	+
	0	+
	0	+	has Node $!root;
	0	+
	0	+
	0	+	method insert($key, $val) {
	0	+	$!root = insert_at_node($!root, $key, $val);
	0	+	$!root.color = 'BLACK';
	0	+	return self;
	0	+	}
	0	+
	0	+	sub insert_at_node($h, $key, $val) {
	0	+	return Node.new($key, $val) unless $h;
	0	+
	0	+	$h.colorFlip()
	0	+	if isRed($h.left) and isRed($h.right);
	0	+
	0	+	given $key cmp $h.key {
	0	+	when 0 { $h.val = $val; } # Update in place
	0	+	when -1 { $h.left = insert_at_node($h.left, $key, $val); }
	0	+	when 1 { $h.right = insert_at_node($h.right, $key, $val); }
	0	+	}
	0	+
	0	+	$h = rotateLeft($h)
	0	+	if isRed($h.right) and not isRed($h.left);
	0	+	$h = rotateRight($h)
	0	+	if isRed($h.left) and isRed($h.left.left);
	0	+
	0	+	return $h;
	0	+	}
	0	+
	0	+	method dump() {
	0	+	dump_node($!root, 0, 'ROOT');
	0	+	}
	0	+
	0	+	sub dump_node($h, $indent, $label) {
	0	+	print ' ' x $indent, "$label:".fmt('%6s'), ' ';
	0	+	if !$h {
	0	+	say ' ' x $indent, "LEAF";
	0	+	}
	0	+	else {
	0	+	say ' ' x $indent, "$h.key => $h.val";
	0	+	dump_node($h.left, $indent + 1, 'Left');
	0	+	dump_node($h.right, $indent + 1, 'Right');
	0	+	}
	0	+	}
	0	+	}
	0	+	20:49 ~/g/code/p6/t$ perl6 -e 'use Tree::LLRB; Tree::LLRB.new().insert(1, True).dump()'
	0	+	Type objects are abstract and have no attributes, but you tried to access $!key
	0	+	in 'Node::new' at line 10:Tree/LLRB.pm6
	0	+	in 'Tree::LLRB::insert_at_node' at line 56:Tree/LLRB.pm6
	0	+	in 'Tree::LLRB::insert' at line 50:Tree/LLRB.pm6
	0	+	in main program body at line 1
	0	+
...