Revision 303561633331 () - Diff

Link to this snippet: https://friendpaste.com/6CFralb4xTPxsiXlEzGkHe
Embed:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
21:09 ~/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) {
                        nextwith(self, :$key, :$val, :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');
                }
        }
}
21:09 ~/g/code/p6/t$ perl6 -e 'use Tree::LLRB; Tree::LLRB.new().insert(1, True).dump()'
too many positional arguments: 2 passed, 1 expected
  in 'Node::new' at line 1
  in 'Tree::LLRB::insert_at_node' at line 53:Tree/LLRB.pm6
  in 'Tree::LLRB::insert' at line 47:Tree/LLRB.pm6
  in main program body at line 1