|
Posted by sln on August 2, 2008, 3:14 pm
Please log in for more thread options
>I guess like almost everybody, I like to discuss (argue) the merits of
>different technologies. In my world, the big two are Java and
>ColdFusion. Recently, we had someone with a background in embedded
>systems who has been advocating C. The conversation goes something
>like this:
>
>him - Does Perl have linked lists?
>me - No.
>him - Therefore, C is better than Perl because it has linked lists.
>me - But Perl has other data structures that are easier to use than
>linked lists.
>him - So what? Perl still doesn't have linked lists.
>
>I've never studied linked lists and certainly never coded one (in C or
>anything else) but it aroused my curiosity. So after searching on
>c.l.p.m. and online, I decided to see if I couldn't do a linked list
>in Perl. My first thought is to do something like this:
>
>%linked_list = { prev => $linked_list,
> value => $value,
> next => $linked_list
> };
>
>I know that most people will think I'm an absolute moron for thinking
>about this (and they likely would be right), but CAN you do a linked
>list in Perl (never mind that you would never want to), and if so, how
>would you go about it?
>
>My motive is to say to my C friend, "Nya, nya, nya."
>
>Thanks, CC.
I think C++ is better than Perl. If you don't know C++, I think Perl is better.
I have a little starter toolkit here for double linked lists. Don't worry if you
only need single lists, it still works.
Like all Lists, the only ambiguity is data. For these functions, I've left the
data
allocation function "new_node()" at the top. Insert your own schema there.
This caveat and a few others prevent me from formalizing Lists in classes.
Many other functions should be added here before that takes place.
As it is, these are Node primitaves. More need to be added, a formalization
process
needs to take place. For instance, binary tree's, joins, non-destructive unlink,
etc..
All in all, I still don't see a need for Lists in Perl, maybe you can find one
or two.
In the below functions, all Node removals and List destructions are Destructive,
ie: the Node (anonymous hash) themselves are destroyed. All future references to
them
become "undef"ined. Thus adding a few more non-destructive functions will give
the option
to plug them into somewhere else.
There are probably bugs, I didn't have time to test it all..
sln
## nodes.pl
## robic0@adelphia.net (my spam mailbox, but I read it)
##
use strict;
use warnings;
### Exercise List Creation and Destruction,
### the bare minimum.
### ---------------------------------------
# Create a new List with 1,000,000 nodes
#-
my $ListHead = CreateList();
my $ListTail = $ListHead;
my $curnode = $ListTail;
$curnode->-> = 0;
print "\nAdding 1,000,000 nodes\n";
for (my $i=1; $i<1000000; $i++)
{
$curnode = CreateTail( $curnode );
$curnode->-> = $i;
$ListTail = $curnode;
}
print "Done, sleeping 5 seconds\n";
sleep(5);
# Destroy it
#-
print "\nDestroying List\n";
DestroyList( $ListHead );
print "Done\n";
# Create a different List with 1,500,000 nodes
#-
$ListHead = CreateList();
$ListTail = $ListHead;
$curnode = $ListTail;
$curnode->-> = 0;
print "\nAdding 1,500,000 nodes\n";
for (my $i=1; $i<1500000; $i++)
{
$curnode = CreateTail( $curnode );
$curnode->-> = $i;
$ListTail = $curnode;
}
print "Done, sleeping 5 seconds\n";
sleep(5);
# Destroy it
#-
print "\nDestroying List\n";
DestroyList( $ListHead );
print "Done\n";
# Traverse the list from the Head, print data
#-
print "\nTraverse list from Head -\n";
$curnode = $ListHead;
while (defined $curnode)
{
if (defined $curnode->->) {
print "data is: val = $curnode->->\n";
}
$curnode = $curnode->;
}
print "sleeping 2 seconds\n";
sleep(2);
# Traverse the list from the Tail, print data
#-
print "\nTraverse list from Tail -\n";
$curnode = $ListTail;
while (defined $curnode)
{
if (defined $curnode->->) {
print "data is: val = $curnode->->\n";
}
$curnode = $curnode->;
}
## =================================
## Node Functions
## =================================
# Make a new node
# Parameters- none
# Return - ref to a new node
# -
sub new_node
{
my $node = {
# Node Header
prev => undef,
next => undef,
# Node Data
data => {val => undef}
};
return $node;
}
# Create a new List
# Parameters - None
# Return - ref to a created List (ListHead)
# -
sub CreateList
{
return new_node();
}
# Destroy the List given any Node
# Parameters - $Node = any node in the List
# Return - None
# Notes - Destructive on all List node's
# -
sub DestroyList
{
my $Node = shift;
if (defined $Node)
{
TruncateListAfter( $Node );
TruncateListBefore( $Node );
undef (%);
}
}
# Create a new List Head from the given Node
# Parameters - $Node = find the head from this node, prepend new created head,
# creates new List if undef
# Return - ref to a created node (ListHead)
# -
sub CreateHead
{
my $Node = shift;
if (defined $Node)
{
while (defined $Node->) {
$Node = $Node->;
}
}
return CreateHeadAtNode( $Node );
}
# Create a new List Tail from the given Node
# Parameters - $Node = find the tail from this node, append new created tail,
# creates new List if undef
# Return - ref to a created node (ListTail)
# Notes - Destructive on truncated node's
# -
sub CreateTail
{
my $Node = shift;
if (defined $Node)
{
while (defined $Node->) {
$Node = $Node->;
}
}
return CreateTailAtNode( $Node );
}
# Create a new Head before Node, removes leading node's
# Parameters - $Node = node to prepend new head,
# creates new List if undef
# Return - ref to a created node (ListHead)
# -
sub CreateHeadAtNode
{
my $Node = shift;
my $ret = undef;
if (defined $Node)
{
my $newnode = new_node();
if (defined $Node->) {
TruncateListBefore( $Node );
}
$newnode-> = $Node;
$Node-> = $newnode;
$ret = $newnode;
} else {
$ret = new_node();
}
return $ret;
}
# Create a new Tail after Node, removes trailing node's
# Parameters - $Node = node to append new tail,
# creates new List if undef
# Return - ref to a created node (ListTail)
# Notes - Destructive on truncated node's
# -
sub CreateTailAtNode
{
my $Node = shift;
my $ret = undef;
if (defined $Node)
{
my $newnode = new_node();
if (defined $Node->) {
TruncateListAfter( $Node );
}
$newnode-> = $Node;
$Node-> = $newnode;
$ret = $newnode;
} else {
$ret = new_node();
}
return $ret;
}
# Add the passed in Node to the List as its new Head
# Parameters - $Node = find the head from this node, prepend new head
# - $NewNode = the new node
# Return - ref to the added node (ListHead)
# -
sub AddHead
{
my ($Node, $NewNode) = @_;
my $ret = undef;
if (defined $Node && defined $NewNode)
{
while (defined $Node->) {
$Node = $Node->;
}
$ret = AddHeadAtNode( $Node, $NewNode );
}
return $ret;
}
# Add the passed in Node to the List as its new Tail
# Parameters - $Node = find the tail from this node, append new tail
# - $NewNode = the new node
# Return - ref to the added node (ListTail)
# -
sub AddTail
{
my ($Node, $NewNode) = @_;
my $ret = undef;
if (defined $Node && defined $NewNode)
{
while (defined $Node->) {
$Node = $Node->;
}
$ret = AddTailAtNode( $Node, $NewNode );
}
return $ret;
}
# Add a new Head before Node, removes leading nodes
# Parameters - $Node = node to prepend new head
# - $NewNode = the new node
# Return - ref to the added node (ListHead)
# Notes - Destructive on truncated node's
# -
sub AddHeadAtNode
{
my ($Node, $NewNode) = @_;
my $ret = undef;
if (defined $Node && defined $NewNode)
{
my $newnode = $NewNode;
if (defined $Node->) {
TruncateListBefore( $Node );
}
$newnode-> = $Node;
$Node-> = $newnode;
$ret = $newnode;
}
return $ret;
}
# Add a new Tail after Node, removes trailing nodes
# Parameters - $Node = node to append new tail
# - $NewNode = the new node
# Return - ref to the added node (ListTail)
# Notes - Destructive on truncated node's
# -
sub AddTailAtNode
{
my ($Node, $NewNode) = @_;
my $ret = undef;
if (defined $Node && defined $NewNode)
{
my $newnode = $NewNode;
if (defined $Node->) {
TruncateListAfter( $Node );
}
$newnode-> = $Node;
$Node-> = $newnode;
$ret = $newnode;
}
return $ret;
}
# Truncate a List after a Node (Node is intact)
# Parameters - $Node = node to disconnect from
# Return - None
# Notes - Destructive on truncated node's
# -
sub TruncateListAfter
{
my $Node = shift;
if (defined $Node)
{
my $curnode = $Node->;
while (defined $curnode)
{
my $nextnode = $curnode->;
undef (%);
$curnode = $nextnode;
}
$Node-> = undef;
}
}
# Truncate a List before a Node (Node is intact)
# Parameters - $Node = node to disconnect from
# Return - None
# Notes - Destructive on truncated node's
# -
sub TruncateListBefore
{
my $Node = shift;
if (defined $Node)
{
my $curnode = $Node->;
while (defined $curnode)
{
my $prevnode = $curnode->;
undef (%);
$curnode = $prevnode;
}
$Node-> = undef;
}
}
# Create a new node after a node
# Parameters - $Node = node to append to
# Return - ref to a created node
# -
sub CreateNextNode
{
my $Node = shift;
return InsertNextNode( $Node, new_node() );
}
# Create a new node before a node
# Parameters - $Node = node to prepend to
# Return - ref to a created node
# -
sub CreatePrevNode
{
my $Node = shift;
return InsertPrevNode( $Node, new_node() );
}
# Insert a passed in node after a node
# Parameters - $Node = node to append to
# - $NewNode = the new node
# Return - ref to the inserted node
# -
sub InsertNextNode
{
my ($Node, $NewNode) = @_;
my $ret = undef;
if (defined $Node && defined $NewNode)
{
my $newnode = $NewNode;
my $nextnode = $Node->;
if (defined $nextnode) {
$nextnode-> = $newnode;
$newnode-> = $nextnode;
}
$newnode-> = $Node;
$Node-> = $newnode;
$ret = $newnode;
}
return $ret;
}
# Insert a passed in node before a node
# Parameters - $Node = node to prepend to
# - $NewNode = the new node
# Return - ref to the inserted node
# -
sub InsertPrevNode
{
my ($Node, $NewNode) = @_;
my $ret = undef;
if (defined $Node && defined $NewNode)
{
my $newnode = $NewNode;
my $prevnode = $Node->;
if (defined $prevnode) {
$prevnode-> = $newnode;
$newnode-> = $prevnode;
}
$newnode-> = $Node;
$Node-> = $newnode;
$ret = $newnode;
}
return $ret;
}
# Remove node from list
# Parameters - $Node = node ref
# Return - ref to next node
# Notes - Destructive on Node
# -
sub RemoveNodeRetNext
{
my $Node = shift;
my $ret = undef;
if (defined $Node)
{
my $nextnode = $Node->;
my $prevnode = $Node->;
undef (%);
if (defined $nextnode && defined $prevnode) {
$nextnode-> = $prevnode;
$prevnode-> = $nextnode;
$ret = $nextnode;
} elsif (defined $nextnode) {
$nextnode-> = undef;
$ret = $nextnode;
} elsif (defined $prevnode) {
$prevnode-> = undef;
}
}
return $ret;
}
# Remove node from list
# Parameters - $Node = node ref
# Return - ref to prev node
# Notes - Destructive on Node
# -
sub RemoveNodeRetPrev
{
my $Node = shift;
my $ret = undef;
if (defined $Node)
{
my $nextnode = $Node->;
my $prevnode = $Node->;
undef (%);
if (defined $nextnode && defined $prevnode) {
$nextnode-> = $prevnode;
$prevnode-> = $nextnode;
$ret = $prevnode;
} elsif (defined $prevnode) {
$prevnode-> = undef;
$ret = $prevnode;
} elsif (defined $nextnode) {
$nextnode-> = undef;
}
}
return $ret;
}
__END__
Output:
c:\>perl nodes.pl
Adding 1,000,000 nodes
Done, sleeping 5 seconds
Destroying List
Done
Adding 1,500,000 nodes
Done, sleeping 5 seconds
Destroying List
Done
Traverse list from Head -
sleeping 2 seconds
Traverse list from Tail -
C:\>
|
XML Sitemap