/usr/share/algotutor/RBTree.pm is in algotutor 0.8.6-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 95 96 97 98 99 100 101 102 103 104 | # Author: Chao-Kuei Hung
# For more info, including license, please see doc/index.html
package RBTree;
# Red-Black Tree
use strict;
use Carp;
use vars qw(@ISA);
@ISA = qw(BST);
use BST;
# sub new { my ($self) = shift; $self->SUPER::new(@_); }
sub insert {
my ($self, $sk_cont, %opts) = @_;
# $sk_cont is search key, should have the same structure as -content=>...
my ($nn, $r, $focus, $grand, $parent, $uncle);
$nn = $self->SUPER::insert($sk_cont, %opts);
$nn->configure(-status=>"discard");
$self->cget(-canvas)->set_mark(0);
$focus = $nn;
while (1) {
$parent = $focus->parent();
last if $parent->cget(-status) ne "discard";
die if $parent->level() <= 0; # impossibe, because root is always black
$grand = $parent->parent();
$uncle = $grand->child(1 - $parent->rank());
if (ref $uncle and $uncle->cget(-status) eq "discard") {
# then parent is not the root
$parent->configure(-status=>"done");
$uncle->configure(-status=>"done");
$grand->configure(-status=>"discard");
$self->cget(-canvas)->set_mark(0);
$focus = $grand;
} else {
if ($focus->rank() != $parent->rank()) {
if ($parent->rank() == 0) {
$parent->rotate_ccw();
} else {
$parent->rotate_cw();
}
$self->cget(-canvas)->set_mark(0);
($focus, $parent) = ($parent, $focus);
}
if ($parent->rank() == 0) {
$grand->rotate_cw();
} else {
$grand->rotate_ccw();
}
$parent->configure(-status=>"done");
$grand->configure(-status=>"discard");
$focus->configure(-status=>"discard");
$self->cget(-canvas)->set_mark(0);
last;
}
}
# make sure root is always black
$self->root()->configure(-status=>"done")
unless $self->root()->cget(-status) eq "done";
return $nn;
}
sub remove {
my ($self, $node) = @_;
print STDERR "remove() not implemented yet, ignored\n";
return undef;
}
$::Config->{RBTree} = {
-appearance => {
%{ ::deep_copy(Configurable::cget("BST", -appearance)) },
done => { -outline=>"Black",-fill=>"Gray",
-thick=>3, -stipple=>"" },
discard => { -outline=>"DarkRed", -fill=>"LightCoral",
-thick=>3, -stipple=>"gray25" },
focus => { -outline=>"DarkBlue", -fill=>"LightBlue",
-thick=>3, -stipple=>"gray25" },
},
};
if ($0 =~ /RBTree.pm$/) {
# being tested as a stand-alone program, so run test code.
require "utilalgo";
my ($mw, $ctrl, $can);
$mw = MainWindow->new(-title=>"main_test");
$can->{main} = gen_can($mw, undef, -elevation=>1, -maxlevel=>2);
$ctrl = gen_ctrl($mw, $can);
my ($tr) = RBTree->new(-canvas=>$can->{main}, %{ do "data/countries.gr" });
# $can->{main}->set_mark(1);
$ctrl->configure(-recorder=>0);
# If the canvas refuses to show any change, remember to verify that:
# - set_mark() was called at least once
# - -recorder is set to zero before entering MainLoop
# Failing to do either of the above will result in a mysterious bug
# that takes days to figure out !@#$%
Tk::MainLoop();
}
1;
|