AVLTree
view release on metacpan or search on metacpan
t/00-load.t
t/01-numbers.t
t/02-custom.t
t/03-leak.t
t/manifest.t
t/pod-coverage.t
t/pod.t
TODO
typemap
xt/boilerplate.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
MANIFEST.SKIP view on Meta::CPAN
\.old$
\#$
\b\.#
\.bak$
\.tmp$
\.#
\.rej$
\..*\.sw.?$
# Avoid OS-specific files/dirs
# Mac OSX metadata
\B\.DS_Store
# Mac OSX SMB mount metadata files
\B\._
# Avoid Devel::Cover and Devel::CoverX::Covered files.
\bcover_db\b
\bcovered\b
# Avoid prove files
\B\.prove$
# Avoid MYMETA files
avltree/avltree.c view on Meta::CPAN
#include <stdlib.h>
#include <stdio.h>
#endif
#ifndef HEIGHT_LIMIT
#define HEIGHT_LIMIT 64 /* Tallest allowable tree */
#endif
typedef struct avlnode {
int balance; /* Balance factor */
SV *data; /* User-defined content */
struct avlnode *link[2]; /* Left (0) and right (1) links */
} avlnode_t;
struct avltree {
avlnode_t *root; /* Top of the tree */
cmp_f cmp; /* Compare two items */
dup_f dup; /* Clone an item (user-defined) */
rel_f rel; /* Destroy an item (user-defined) */
size_t size; /* Number of items (user-defined) */
};
avltree/avltree.c view on Meta::CPAN
double ( root, dir ); \
} \
else { /* n->balance == 0 */ \
root->balance = -bal; \
n->balance = bal; \
single ( root, dir ); \
done = 1; \
} \
} while (0)
static avlnode_t *new_node ( avltree_t *tree, SV *data )
{
avlnode_t *rn = (avlnode_t *)malloc ( sizeof *rn );
if ( rn == NULL )
return NULL;
rn->balance = 0;
rn->data = tree->dup ( data );
rn->link[0] = rn->link[1] = NULL;
return rn;
}
avltree_t *avltree_new ( cmp_f cmp, dup_f dup, rel_f rel )
{
avltree_t *rt = (avltree_t *)malloc ( sizeof *rt );
if ( rt == NULL )
avltree/avltree.c view on Meta::CPAN
void avltree_delete ( avltree_t *tree )
{
avlnode_t *it = tree->root;
avlnode_t *save;
/* Destruction by rotation */
while ( it != NULL ) {
if ( it->link[0] == NULL ) {
/* Remove node */
save = it->link[1];
tree->rel ( it->data );
free ( it );
}
else {
/* Rotate right */
save = it->link[0];
it->link[0] = save->link[1];
save->link[1] = it;
}
it = save;
}
free ( tree );
}
SV *avltree_find (pTHX_ avltree_t *tree, SV *data )
{
avlnode_t *it = tree->root;
while ( it != NULL ) {
int cmp = tree->cmp ( it->data, data );
if ( cmp == 0 )
break;
it = it->link[cmp < 0];
}
return it == NULL ? &PL_sv_undef : it->data;
}
int avltree_insert ( avltree_t *tree, SV *data )
{
/* Empty tree case */
if ( tree->root == NULL ) {
tree->root = new_node ( tree, data );
if ( tree->root == NULL )
return 0;
}
else {
avlnode_t head = {0}; /* Temporary tree root */
avlnode_t *s, *t; /* Place to rebalance and parent */
avlnode_t *p, *q; /* Iterator and save pointer */
int dir;
/* Set up false root to ease maintenance */
t = &head;
t->link[1] = tree->root;
/* Search down the tree, saving rebalance points */
for ( s = p = t->link[1]; ; p = q ) {
dir = tree->cmp ( p->data, data ) < 0;
q = p->link[dir];
if ( q == NULL )
break;
if ( q->balance != 0 ) {
t = p;
s = q;
}
}
p->link[dir] = q = new_node ( tree, data );
if ( q == NULL )
return 0;
/* Update balance factors */
for ( p = s; p != q; p = p->link[dir] ) {
dir = tree->cmp ( p->data, data ) < 0;
p->balance += dir == 0 ? -1 : +1;
}
q = s; /* Save rebalance point for parent fix */
/* Rebalance if necessary */
if ( abs ( s->balance ) > 1 ) {
dir = tree->cmp ( s->data, data ) < 0;
insert_balance ( s, dir );
}
/* Fix parent */
if ( q == head.link[1] )
tree->root = s;
else
t->link[q == t->link[1]] = s;
}
++tree->size;
return 1;
}
int avltree_erase ( avltree_t *tree, SV *data )
{
if ( tree->root != NULL ) {
avlnode_t *it, *up[HEIGHT_LIMIT];
int upd[HEIGHT_LIMIT], top = 0;
int done = 0;
it = tree->root;
/* Search down tree and save path */
for ( ; ; ) {
if ( it == NULL )
return 0;
else if ( tree->cmp ( it->data, data ) == 0 )
break;
/* Push direction and node onto stack */
upd[top] = tree->cmp ( it->data, data ) < 0;
up[top++] = it;
it = it->link[upd[top - 1]];
}
/* Remove the node */
if ( it->link[0] == NULL || it->link[1] == NULL ) {
/* Which child is not null? */
int dir = it->link[0] == NULL;
/* Fix parent */
if ( top != 0 )
up[top - 1]->link[upd[top - 1]] = it->link[dir];
else
tree->root = it->link[dir];
tree->rel ( it->data );
free ( it );
}
else {
/* Find the inorder successor */
avlnode_t *heir = it->link[1];
SV *save;
/* Save this path too */
upd[top] = 1;
up[top++] = it;
while ( heir->link[0] != NULL ) {
upd[top] = 0;
up[top++] = heir;
heir = heir->link[0];
}
/* Swap data */
save = it->data;
it->data = heir->data;
heir->data = save;
/* Unlink successor and fix parent */
up[top - 1]->link[up[top - 1] == it] = heir->link[1];
tree->rel ( heir->data );
free ( heir );
}
/* Walk back up the search path */
while ( --top >= 0 && !done ) {
/* Update balance factors */
up[top]->balance += upd[top] != 0 ? -1 : +1;
/* Terminate or rebalance as necessary */
if ( abs ( up[top]->balance ) == 1 )
avltree/avltree.c view on Meta::CPAN
trav->top = 0;
/* Build a path to work with */
if ( trav->it != NULL ) {
while ( trav->it->link[dir] != NULL ) {
trav->path[trav->top++] = trav->it;
trav->it = trav->it->link[dir];
}
}
return trav->it == NULL ? &PL_sv_undef : trav->it->data;
}
/*
Subsequent traversal steps,
handles ascending and descending
*/
static SV *move (pTHX_ avltrav_t *trav, int dir )
{
if ( trav->it->link[dir] != NULL ) {
/* Continue down this branch */
avltree/avltree.c view on Meta::CPAN
if ( trav->top == 0 ) {
trav->it = NULL;
break;
}
last = trav->it;
trav->it = trav->path[--trav->top];
} while ( last == trav->it->link[dir] );
}
return trav->it == NULL ? &PL_sv_undef : trav->it->data;
}
SV *avltfirst (pTHX_ avltrav_t *trav, avltree_t *tree )
{
return start (aTHX_ trav, tree, 0 ); /* Min value */
}
SV *avltlast (pTHX_ avltrav_t *trav, avltree_t *tree )
{
return start (aTHX_ trav, tree, 1 ); /* Max value */
avltree/avltree.h view on Meta::CPAN
typedef struct avltrav avltrav_t;
/* User-defined item handling */
typedef int (*cmp_f) ( SV *p1, SV *p2 );
typedef SV *(*dup_f) ( SV* p );
typedef void (*rel_f) ( SV* p );
/* AVL tree functions */
avltree_t *avltree_new ( cmp_f cmp, dup_f dup, rel_f rel );
void avltree_delete ( avltree_t *tree );
SV *avltree_find ( pTHX_ avltree_t *tree, SV *data );
int avltree_insert ( avltree_t *tree, SV *data );
int avltree_erase ( avltree_t *tree, SV *data );
size_t avltree_size ( avltree_t *tree );
/* Traversal functions */
avltrav_t *avltnew ( void );
void avltdelete ( avltrav_t *trav );
SV *avltfirst (pTHX_ avltrav_t *trav, avltree_t *tree );
SV *avltlast (pTHX_ avltrav_t *trav, avltree_t *tree );
SV *avltnext (pTHX_ avltrav_t *trav );
SV *avltprev (pTHX_ avltrav_t *trav );
lib/AVLTree.pm view on Meta::CPAN
if($tree->remove($item)) {
print "Item $item has been removed\n";
} else {
print "Item $item was not in the tree so it's not been removed\n";
}
printf "Size of tree is now: %d\n", $tree->size();
...
# Suppose you want the tree to hold generic data items, e.g. hashrefs
# which hold some data. We can deal with these by definying a custom
# comparison function based on one of the attributes of these data items,
# e.g. 'id':
sub compare {
my ($i1, $i2) = @_;
my ($id1, $id2) = ($i1->{id}, $i2->{id});
croak "Cannot compare items based on id"
unless defined $id1 and defined $id2;
return $id1<$id2?-1:($id1>$id2)?1:0;
}
# Now can do the same as with numbers
my $tree = AVLTree->new(\&compare);
my $insert_ok = $tree->insert({ id => 10, data => 'ten' });
croak "Could not insert item" unless $insert_ok;
$insert_ok = $tree->insert({ id => 20, data => 'twenty' });
...
my $id = 10;
my $result = $tree->find({ id => $id });
if($result) {
printf "Item with id %d found\nData: %s\n", $id, $result->{data};
} else {
print "Item with id $id not found\n";
}
# forward tree traversal
my $item = $tree->first();
print "First item: ", $item, "\n";
while($item = $tree->next()) {
print $item, "\n";
lib/AVLTree.pm view on Meta::CPAN
Exceptions : None
Caller : General
Status : Unstable, interface might change to accomodate suitable defaults,
e.g. numbers
=head2 C<find>
Arg [1] : Item to search, can be defined just in terms of the attribute
with which the items in the tree are compared.
Example : $tree->find({ id => 10 }); # objects in the tree can hold data as well
if($result) {
printf "Item with id %d found\nData: %s\n", $id, $result->{data};
} else { print "Item with id $id not found\n"; }
Description : Query if an item exists in the tree.
Returntype : The item, if found, as stored in the tree or undef
if the item was not found or the query was not provided
or it was undefined.
Exceptions : None
Caller : General
Status : Unstable
=head2 C<insert>
Arg [1] : An item to insert in the tree.
Example : my $ok = $tree->insert({ id => 10, data => 'ten' });
croak "Unable to insert 10" unless $ok;
Description : Insert an item in the tree, use the provided, upon tree construction,
comparison function to determine the position of the item in the tree
Returntype : Bool, true if the item was successfully installed, false otherwise
Exceptions : None
Caller : General
Status : Unstable
PERL_MAGIC_glob|5.014000||p
PERL_MAGIC_isaelem|5.007002||p
PERL_MAGIC_isa|5.007002||p
PERL_MAGIC_mutex|5.014000||p
PERL_MAGIC_nkeys|5.007002||p
PERL_MAGIC_overload_elem|5.007002||p
PERL_MAGIC_overload_table|5.007002||p
PERL_MAGIC_overload|5.007002||p
PERL_MAGIC_pos|5.007002||p
PERL_MAGIC_qr|5.007002||p
PERL_MAGIC_regdata|5.007002||p
PERL_MAGIC_regdatum|5.007002||p
PERL_MAGIC_regex_global|5.007002||p
PERL_MAGIC_shared_scalar|5.007003||p
PERL_MAGIC_shared|5.007003||p
PERL_MAGIC_sigelem|5.007002||p
PERL_MAGIC_sig|5.007002||p
PERL_MAGIC_substr|5.007002||p
PERL_MAGIC_sv|5.007002||p
PERL_MAGIC_taint|5.007002||p
PERL_MAGIC_tiedelem|5.007002||p
_swash_inversion_hash|||
_swash_to_invlist|||
aMY_CXT_|5.007003||p
aMY_CXT|5.007003||p
aTHXR_|5.014000||p
aTHXR|5.014000||p
aTHX_|5.006000||p
aTHX|5.006000||p
add_alternate|||
add_cp_to_invlist|||
add_data|||n
add_range_to_invlist|||
add_utf16_textfilter|||
addmad|||
allocmy|||
amagic_call|||
amagic_cmp_locale|||
amagic_cmp|||
amagic_deref_call||5.013007|
amagic_i_ncmp|||
amagic_ncmp|||
magic_gettaint|||
magic_getuvar|||
magic_getvec|||
magic_get|||
magic_killbackrefs|||
magic_len|||
magic_methcall1|||
magic_methcall|||v
magic_methpack|||
magic_nextpack|||
magic_regdata_cnt|||
magic_regdatum_get|||
magic_regdatum_set|||
magic_scalarpack|||
magic_set_all_env|||
magic_setamagic|||
magic_setarylen|||
magic_setcollxfrm|||
magic_setdbline|||
magic_setdefelem|||
magic_setenv|||
modkids|||
mod|||
more_bodies|||
more_sv|||
moreswitches|||
mro_clean_isarev|||
mro_gather_and_rename|||
mro_get_from_name||5.010001|
mro_get_linear_isa_dfs|||
mro_get_linear_isa||5.009005|
mro_get_private_data||5.010001|
mro_isa_changed_in|||
mro_meta_dup|||
mro_meta_init|||
mro_method_changed_in||5.009005|
mro_package_moved|||
mro_register||5.010001|
mro_set_mro||5.010001|
mro_set_private_data||5.010001|
mul128|||
mulexp10|||n
munge_qwlist_to_paren_list|||
my_atof2||5.007002|
my_atof||5.006000|
my_attrs|||
my_bcopy|||n
my_betoh16|||n
my_betoh32|||n
my_betoh64|||n
PL_hints = oldhints;
PL_curcop->cop_stash = old_cop_stash;
PL_curstash = old_curstash;
PL_curcop->cop_line = oldline;
}
#endif
#endif
/*
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
* this, if you want to make the extension thread-safe. See ext/re/re.xs
* for an example of the use of these macros.
*
* Code that uses these macros is responsible for the following:
* 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
* 2. Declare a typedef named my_cxt_t that is a structure that contains
* all the data that needs to be interpreter-local.
* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
* 4. Use the MY_CXT_INIT macro such that it is called exactly once
* (typically put in the BOOT: section).
* 5. Use the members of the my_cxt_t structure everywhere as
* MY_CXT.member.
* 6. Use the dMY_CXT macro (a declaration) in all the functions that
* access MY_CXT.
*/
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
#ifndef START_MY_CXT
/* This must appear in all extensions that define a my_cxt_t structure,
* right after the definition (i.e. at file scope). The non-threads
* case below uses it to declare the data as static. */
#define START_MY_CXT
#if (PERL_BCDVERSION < 0x5004068)
/* Fetches the SV that keeps the per-interpreter data. */
#define dMY_CXT_SV \
SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
#else /* >= perl5.004_68 */
#define dMY_CXT_SV \
SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
sizeof(MY_CXT_KEY)-1, TRUE)
#endif /* < perl5.004_68 */
/* This declaration should be used within all functions that use the
* interpreter-local data. */
#define dMY_CXT \
dMY_CXT_SV; \
my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
/* Creates and zeroes the per-interpreter data.
* (We allocate my_cxtp in a Perl SV so that it will be released when
* the interpreter goes away.) */
#define MY_CXT_INIT \
dMY_CXT_SV; \
/* newSV() allocates one more than needed */ \
my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
Zero(my_cxtp, 1, my_cxt_t); \
sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
/* This macro must be used to access members of the my_cxt_t structure.
* e.g. MYCXT.some_data */
#define MY_CXT (*my_cxtp)
/* Judicious use of these macros can reduce the number of times dMY_CXT
* is used. Use is similar to pTHX, aTHX etc. */
#define pMY_CXT my_cxt_t *my_cxtp
#define pMY_CXT_ pMY_CXT,
#define _pMY_CXT ,pMY_CXT
#define aMY_CXT my_cxtp
#define aMY_CXT_ aMY_CXT,
#define _aMY_CXT ,aMY_CXT
#endif /* START_MY_CXT */
#ifndef MY_CXT_CLONE
/* Clones the per-interpreter data. */
#define MY_CXT_CLONE \
dMY_CXT_SV; \
my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
#endif
#else /* single interpreter */
#ifndef START_MY_CXT
#endif
#endif
#if (PERL_BCDVERSION < 0x5006000)
# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
#else
# define D_PPP_CONSTPV_ARG(x) (x)
#endif
#ifndef newSVpvn
# define newSVpvn(data,len) ((data) \
? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
: newSV(0))
#endif
#ifndef newSVpvn_utf8
# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
#endif
#ifndef SVf_UTF8
# define SVf_UTF8 0
#endif
#ifndef newSVpvn_flags
#endif
#ifndef PERL_MAGIC_overload_table
# define PERL_MAGIC_overload_table 'c'
#endif
#ifndef PERL_MAGIC_bm
# define PERL_MAGIC_bm 'B'
#endif
#ifndef PERL_MAGIC_regdata
# define PERL_MAGIC_regdata 'D'
#endif
#ifndef PERL_MAGIC_regdatum
# define PERL_MAGIC_regdatum 'd'
#endif
#ifndef PERL_MAGIC_env
# define PERL_MAGIC_env 'E'
#endif
if (radix && IN_LOCALE) {
STRLEN len = strlen(radix);
if (*sp + len <= send && memEQ(*sp, radix, len)) {
*sp += len;
return TRUE;
}
}
#endif
#endif /* USE_LOCALE_NUMERIC */
/* always try "." if numeric radix didn't match because
* we may have data from different locales mixed */
if (*sp < send && **sp == '.') {
++*sp;
return TRUE;
}
return FALSE;
}
#endif
#endif
#ifndef grok_number
t/02-custom.t view on Meta::CPAN
use warnings;
use Test::More;
use Test::Deep;
use Carp;
plan tests => 31;
use AVLTree;
# test AVL tree with custom data
# suppose data comes as a hash ref where the comparison is based on
# on the values associated to a given key, e.g. id
sub cmp_f {
my ($i1, $i2) = @_;
my ($id1, $id2) = ($i1->{id}, $i2->{id});
croak "Cannot compare items based on id"
unless defined $id1 and defined $id2;
return $id1<$id2?-1:($id1>$id2)?1:0;
}
my $tree = AVLTree->new(\&cmp_f);
isa_ok($tree, "AVLTree");
is($tree->size(), 0, "Empty tree upon construction");
ok(!$tree->first, 'First element does not exist');
ok(!$tree->last, 'Last element does not exist');
my $items =
[
{ id => 10, data => ['ten'] },
{ id => 20, data => ['twenty'] },
{ id => 30, data => ['thirty'] },
{ id => 40, data => ['forty'] },
{ id => 50, data => ['fifty'] },
{ id => 25, data => ['twentyfive'] },
];
map { ok($tree->insert($_), "Insert item") } @{$items};
is($tree->size(), 6, "Tree size after insertion");
ok(!$tree->find(), "No query");
ok(!$tree->find(undef), "Undefined query");
my $query = { id => 30, data => 'something' };
my $result = $tree->find($query);
ok($result, "Item found");
cmp_deeply($result, { id => 30, data => ['thirty'] }, "Item returned");
ok(!$tree->find({ id => 18 }), "Item not found");
ok(!$tree->remove({ id => 1 }), "Non existent item not removed");
is($tree->size(), 6, "Tree size preserved after unsuccessful removal");
ok($tree->remove({ id => 20 }), "Existing item removed");
ok(!$tree->find({ id => 20 }), "Item removed not found");
is($tree->size(), 5, "Tree size preserved after unsuccessful removal");
# test traversal
t/03-leak.t view on Meta::CPAN
} 'After inserting&querying';
no_leaks_ok {
my $tree = AVLTree->new(\&cmp_numbers);
map { $tree->insert($_) } qw/10 20 30 40 50 25/;
$tree->remove(1); # unsuccessful removal
$tree->remove(10); # successful removal
} 'After inserting&removing';
# repeat with custom data
no_leaks_ok {
my $tree = AVLTree->new(\&cmp_custom);
} 'Empty tree';
no_leaks_ok {
my $tree = AVLTree->new(\&cmp_custom);
map { $tree->insert($_) }
({ id => 10, data => 'ten' },
{ id => 20, data => 'twenty' },
{ id => 30, data => 'thirty' },
{ id => 40, data => 'forty' },
{ id => 50, data => 'fifty' },
{ id => 25, data => 'twneryfive' });
} 'Non-empty tree';
no_leaks_ok {
my $tree = AVLTree->new(\&cmp_custom);
map { $tree->insert($_) }
({ id => 10, data => 'ten' },
{ id => 20, data => 'twenty' },
{ id => 30, data => 'thirty' },
{ id => 40, data => 'forty' },
{ id => 50, data => 'fifty' },
{ id => 25, data => 'twneryfive' });
my $query = { id => 30 };
my $result = $tree->find($query);
} 'After inserting&querying';
no_leaks_ok {
my $tree = AVLTree->new(\&cmp_custom);
map { $tree->insert($_) }
({ id => 10, data => 'ten' },
{ id => 20, data => 'twenty' },
{ id => 30, data => 'thirty' },
{ id => 40, data => 'forty' },
{ id => 50, data => 'fifty' },
{ id => 25, data => 'twneryfive' });
$tree->remove({ id => 1 }); # unsuccessful removal
$tree->remove({ id => 10 }); # successful removal
} 'After inserting&removing';
no_leaks_ok {
my $tree = AVLTree->new(\&cmp_custom);
map { $tree->insert($_) }
({ id => 10, data => 'ten' },
{ id => 20, data => 'twenty' },
{ id => 30, data => 'thirty' },
{ id => 40, data => 'forty' },
{ id => 50, data => 'fifty' },
{ id => 25, data => 'twneryfive' });
my $item = $tree->first;
while ($item = $tree->next) {}
} 'Tree traversal';
diag( "Testing memory leaking AVLTree $AVLTree::VERSION, Perl $], $^X" );
( run in 0.438 second using v1.01-cache-2.11-cpan-8d75d55dd25 )