File Coverage

blib/lib/Tree/Trek.pm

Criterion	Covered	Total	%
statement	81	81	100.0
branch	19	24	79.1
condition	2	2	100.0
subroutine	18	18	100.0
pod	7	8	87.5
total	127	133	95.4

#!/usr/bin/perl -I/home/phil/perl/cpan/DataTableText/lib/
#-------------------------------------------------------------------------------
# Trek through a tree one character at a time.
# Philip R Brenan at appaapps dot com, Appa Apps Ltd Inc., 2021
#-------------------------------------------------------------------------------
# podDocumentation
package Tree::Trek;
our $VERSION = "20210425";
use warnings FATAL => qw(all);
use strict;
use Carp qw(confess cluck);
use Data::Dump qw(dump);
use Data::Table::Text qw(:all);
use feature qw(say current_sub);

my $debug = -e q(/home/phil/);                                                  # Developing

#D1 Tree::Trek                                                                  # Methods to create and traverse a trekkable tree.

sub node(;$$)                                                                   # Create a new node
 {my ($parent, $char) = @_;                                                     # Optional parent, character we came through on
  genHash(__PACKAGE__,
    jumps  => {},                                                               # {character => node}
    data   => undef,                                                            # The data attached to this node
    parent => $parent,                                                          # The node from whence we came
    char   => $char//'',                                                        # The character we trekked in on or the empty string if we are at the root
   );
 }

sub put($$)                                                                     # Add a key to the tree
 {my ($tree, $key) = @_;                                                        # Tree, key

  return $tree unless $key;                                                     # Key is empty so we have found the desired node

  for my $i(1..length $key)                                                     # Jump on each character
   {my $c = substr $key, $i-1, 1;                                               # Next character of the key

    if (exists $tree->jumps->{$c})                                              # Jump through existing node
     {$tree = $tree->jumps->{$c};
     }
    else                                                                        # Create a new node and jump through it
     {$tree = ($tree->jumps->{$c} = node $tree, $c);
     }
   }

  $tree                                                                         # Last node we reached at the end of the string
 }

sub key($)                                                                      # Return the key of a node
 {my ($node) = @_;                                                              # Node
  my $k = '';
  for(my $n = $node; $n; $n = $n->parent)
   {$k .= $n->char
   }
  scalar reverse $k;
 }

sub find($$)                                                                    # Find a key in a tree - return its node if such a node exists else undef
 {my ($tree, $key) = @_;                                                        # Tree, key

  return $tree unless $key;                                                     # We have exhausted the key so this must be the node in question as long as it has no jumps

  for my $i(1..length $key)                                                     # Jump on each character
   {my $c = substr $key, $i-1, 1;                                               # Next character of the key
    if (exists $tree->jumps->{$c})                                              # Continue search
     {$tree = $tree->jumps->{$c};
      next;
     }
    return undef;                                                               # No such jump
   }
  $tree                                                                         # Not found
 }

sub delete($)                                                                   # Remove a node from a tree
 {my ($node) = @_;                                                              # Node to be removed

  $node->data = undef;                                                          # Clear data
  if (! keys $node->jumps->%*)                                                  # No jumps from this node and no data so we can clear it from the parent
   {for(my $n = $node; $n; $n = $n->parent)                                     # Up through ancestors
     {if (my $p = $n->parent)                                                   # Parent of current node
       {delete $p->jumps->{$n->char};                                           # Delete path to empty node
        last if keys $p->jumps->%*;                                             # Repeat for parent if this node is now empty
       }
     }
   }
  $node
 }

sub count($)                                                                    # Count the nodes addressed in the specified tree
 {my ($node) = @_;                                                              # Node to be counted from
  my $n = $node->data ? 1 : 0;                                                  # Count the nodes addressed in the specified tree
  for my $c(keys $node->jumps->%*)                                              # Each possible child
   {$n += $node->jumps->{$c}->count;                                            # Each child of the parent
   }
  $n                                                                            # Count
 }

sub traverse($)                                                                 # Traverse a tree returning an array of nodes
 {my ($node) = @_;                                                              # Node to be counted from
  my @n;
  push @n, $node if $node->data;
  for my $c(sort keys $node->jumps->%*)                                         # Each possible child in key order
   {push @n, $node->jumps->{$c}->traverse;
   }
  @n
 }

#d
#-------------------------------------------------------------------------------
# Export
#-------------------------------------------------------------------------------

use Exporter qw(import);

use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

@ISA          = qw(Exporter);
@EXPORT       = qw();
@EXPORT_OK    = qw(
 );
%EXPORT_TAGS = (all=>[@EXPORT, @EXPORT_OK]);

# podDocumentation
=pod

=encoding utf-8

=head1 Name

Tree::Trek - Trek through a tree one character at a time.

=head1 Synopsis

Create a trekkable tree and trek through it:

  my $n = node;

  $n->put("aa") ->data = "AA";
  $n->put("ab") ->data = "AB";
  $n->put("ba") ->data = "BA";
  $n->put("bb") ->data = "BB";
  $n->put("aaa")->data = "AAA";

  is_deeply [map {[$_->key, $_->data]} $n->traverse],
   [["aa",  "AA"],
    ["aaa", "AAA"],
    ["ab",  "AB"],
    ["ba",  "BA"],
    ["bb",  "BB"]];

=head1 Description

Trek through a tree one character at a time.


Version "20210424".


The following sections describe the methods in each functional area of this
module.  For an alphabetic listing of all methods by name see L.



=head1 Tree::Trek

Methods to create a  trekkable tree.

=head2 node($parent)

Create a new node

     Parameter  Description
  1  $parent    Optional parent

B


  if (1)

   {my $n = node;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    $n->put("aa")->data = "AA";
    $n->put("ab")->data = "AB";
    $n->put("ba")->data = "BA";
    $n->put("bb")->data = "BB";
    $n->put("aaa")->data = "AAA";
    is_deeply $n->count, 5;

    is_deeply $n->find("aa") ->data, "AA";
    is_deeply $n->find("ab") ->data, "AB";
    is_deeply $n->find("ba") ->data, "BA";
    is_deeply $n->find("bb") ->data, "BB";
    is_deeply $n->find("aaa")->data, "AAA";

    is_deeply [map {[$_->key, $_->data]} $n->traverse],
     [["aa",  "AA"],
      ["aaa", "AAA"],
      ["ab",  "AB"],
      ["ba",  "BA"],
      ["bb",  "BB"]];

    ok  $n->find("a");
    ok !$n->find("a")->data;
    ok  $n->find("b");
    ok !$n->find("b")->data;
    ok !$n->find("c");

    ok $n->find("aa")->delete;  ok  $n->find("aa");  is_deeply $n->count, 4;
    ok $n->find("ab")->delete;  ok !$n->find("ab");  is_deeply $n->count, 3;
    ok $n->find("ba")->delete;  ok !$n->find("ba");  is_deeply $n->count, 2;
    ok $n->find("bb")->delete;  ok !$n->find("bb");  is_deeply $n->count, 1;

    ok  $n->find("a");
    ok !$n->find("b");

    ok $n->find("aaa")->delete; ok !$n->find("aaa"); is_deeply $n->count, 0;
    ok  !$n->find("a");
   }


=head2 put($tree, $key)

Add a key to the tree

     Parameter  Description
  1  $tree      Tree
  2  $key       Key

B


  if (1)
   {my $n = node;

    $n->put("aa")->data = "AA";  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    $n->put("ab")->data = "AB";  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    $n->put("ba")->data = "BA";  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    $n->put("bb")->data = "BB";  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    $n->put("aaa")->data = "AAA";  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    is_deeply $n->count, 5;

    is_deeply $n->find("aa") ->data, "AA";
    is_deeply $n->find("ab") ->data, "AB";
    is_deeply $n->find("ba") ->data, "BA";
    is_deeply $n->find("bb") ->data, "BB";
    is_deeply $n->find("aaa")->data, "AAA";

    is_deeply [map {[$_->key, $_->data]} $n->traverse],
     [["aa",  "AA"],
      ["aaa", "AAA"],
      ["ab",  "AB"],
      ["ba",  "BA"],
      ["bb",  "BB"]];

    ok  $n->find("a");
    ok !$n->find("a")->data;
    ok  $n->find("b");
    ok !$n->find("b")->data;
    ok !$n->find("c");

    ok $n->find("aa")->delete;  ok  $n->find("aa");  is_deeply $n->count, 4;
    ok $n->find("ab")->delete;  ok !$n->find("ab");  is_deeply $n->count, 3;
    ok $n->find("ba")->delete;  ok !$n->find("ba");  is_deeply $n->count, 2;
    ok $n->find("bb")->delete;  ok !$n->find("bb");  is_deeply $n->count, 1;

    ok  $n->find("a");
    ok !$n->find("b");

    ok $n->find("aaa")->delete; ok !$n->find("aaa"); is_deeply $n->count, 0;
    ok  !$n->find("a");
   }


=head2 key($node)

Return the key of a node

     Parameter  Description
  1  $node      Node

B


  if (1)
   {my $n = node;
    $n->put("aa")->data = "AA";
    $n->put("ab")->data = "AB";
    $n->put("ba")->data = "BA";
    $n->put("bb")->data = "BB";
    $n->put("aaa")->data = "AAA";
    is_deeply $n->count, 5;

    is_deeply $n->find("aa") ->data, "AA";
    is_deeply $n->find("ab") ->data, "AB";
    is_deeply $n->find("ba") ->data, "BA";
    is_deeply $n->find("bb") ->data, "BB";
    is_deeply $n->find("aaa")->data, "AAA";


    is_deeply [map {[$_->key, $_->data]} $n->traverse],  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

     [["aa",  "AA"],
      ["aaa", "AAA"],
      ["ab",  "AB"],
      ["ba",  "BA"],
      ["bb",  "BB"]];

    ok  $n->find("a");
    ok !$n->find("a")->data;
    ok  $n->find("b");
    ok !$n->find("b")->data;
    ok !$n->find("c");

    ok $n->find("aa")->delete;  ok  $n->find("aa");  is_deeply $n->count, 4;
    ok $n->find("ab")->delete;  ok !$n->find("ab");  is_deeply $n->count, 3;
    ok $n->find("ba")->delete;  ok !$n->find("ba");  is_deeply $n->count, 2;
    ok $n->find("bb")->delete;  ok !$n->find("bb");  is_deeply $n->count, 1;

    ok  $n->find("a");
    ok !$n->find("b");

    ok $n->find("aaa")->delete; ok !$n->find("aaa"); is_deeply $n->count, 0;
    ok  !$n->find("a");
   }


=head2 find($tree, $key)

Find a key in a tree - return its node if such a node exists else undef

     Parameter  Description
  1  $tree      Tree
  2  $key       Key

B


  if (1)
   {my $n = node;
    $n->put("aa")->data = "AA";
    $n->put("ab")->data = "AB";
    $n->put("ba")->data = "BA";
    $n->put("bb")->data = "BB";
    $n->put("aaa")->data = "AAA";
    is_deeply $n->count, 5;


    is_deeply $n->find("aa") ->data, "AA";  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    is_deeply $n->find("ab") ->data, "AB";  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    is_deeply $n->find("ba") ->data, "BA";  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    is_deeply $n->find("bb") ->data, "BB";  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    is_deeply $n->find("aaa")->data, "AAA";  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    is_deeply [map {[$_->key, $_->data]} $n->traverse],
     [["aa",  "AA"],
      ["aaa", "AAA"],
      ["ab",  "AB"],
      ["ba",  "BA"],
      ["bb",  "BB"]];


    ok  $n->find("a");  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok !$n->find("a")->data;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok  $n->find("b");  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok !$n->find("b")->data;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok !$n->find("c");  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲



    ok $n->find("aa")->delete;  ok  $n->find("aa");  is_deeply $n->count, 4;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok $n->find("ab")->delete;  ok !$n->find("ab");  is_deeply $n->count, 3;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok $n->find("ba")->delete;  ok !$n->find("ba");  is_deeply $n->count, 2;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok $n->find("bb")->delete;  ok !$n->find("bb");  is_deeply $n->count, 1;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲



    ok  $n->find("a");  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok !$n->find("b");  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲



    ok $n->find("aaa")->delete; ok !$n->find("aaa"); is_deeply $n->count, 0;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok  !$n->find("a");  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

   }


=head2 delete($node)

Remove a node from a tree

     Parameter  Description
  1  $node      Node to be removed

B


  if (1)
   {my $n = node;
    $n->put("aa")->data = "AA";
    $n->put("ab")->data = "AB";
    $n->put("ba")->data = "BA";
    $n->put("bb")->data = "BB";
    $n->put("aaa")->data = "AAA";
    is_deeply $n->count, 5;

    is_deeply $n->find("aa") ->data, "AA";
    is_deeply $n->find("ab") ->data, "AB";
    is_deeply $n->find("ba") ->data, "BA";
    is_deeply $n->find("bb") ->data, "BB";
    is_deeply $n->find("aaa")->data, "AAA";

    is_deeply [map {[$_->key, $_->data]} $n->traverse],
     [["aa",  "AA"],
      ["aaa", "AAA"],
      ["ab",  "AB"],
      ["ba",  "BA"],
      ["bb",  "BB"]];

    ok  $n->find("a");
    ok !$n->find("a")->data;
    ok  $n->find("b");
    ok !$n->find("b")->data;
    ok !$n->find("c");


    ok $n->find("aa")->delete;  ok  $n->find("aa");  is_deeply $n->count, 4;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok $n->find("ab")->delete;  ok !$n->find("ab");  is_deeply $n->count, 3;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok $n->find("ba")->delete;  ok !$n->find("ba");  is_deeply $n->count, 2;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok $n->find("bb")->delete;  ok !$n->find("bb");  is_deeply $n->count, 1;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok  $n->find("a");
    ok !$n->find("b");


    ok $n->find("aaa")->delete; ok !$n->find("aaa"); is_deeply $n->count, 0;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    ok  !$n->find("a");
   }


=head2 count($node)

Count the nodes addressed in the specified tree

     Parameter  Description
  1  $node      Node to be counted from

B


  if (1)
   {my $n = node;
    $n->put("aa")->data = "AA";
    $n->put("ab")->data = "AB";
    $n->put("ba")->data = "BA";
    $n->put("bb")->data = "BB";
    $n->put("aaa")->data = "AAA";

    is_deeply $n->count, 5;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    is_deeply $n->find("aa") ->data, "AA";
    is_deeply $n->find("ab") ->data, "AB";
    is_deeply $n->find("ba") ->data, "BA";
    is_deeply $n->find("bb") ->data, "BB";
    is_deeply $n->find("aaa")->data, "AAA";

    is_deeply [map {[$_->key, $_->data]} $n->traverse],
     [["aa",  "AA"],
      ["aaa", "AAA"],
      ["ab",  "AB"],
      ["ba",  "BA"],
      ["bb",  "BB"]];

    ok  $n->find("a");
    ok !$n->find("a")->data;
    ok  $n->find("b");
    ok !$n->find("b")->data;
    ok !$n->find("c");


    ok $n->find("aa")->delete;  ok  $n->find("aa");  is_deeply $n->count, 4;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok $n->find("ab")->delete;  ok !$n->find("ab");  is_deeply $n->count, 3;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok $n->find("ba")->delete;  ok !$n->find("ba");  is_deeply $n->count, 2;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok $n->find("bb")->delete;  ok !$n->find("bb");  is_deeply $n->count, 1;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲


    ok  $n->find("a");
    ok !$n->find("b");


    ok $n->find("aaa")->delete; ok !$n->find("aaa"); is_deeply $n->count, 0;  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

    ok  !$n->find("a");
   }


=head2 traverse($node)

Traverse a tree returning an array of nodes

     Parameter  Description
  1  $node      Node to be counted from

B


  if (1)
   {my $n = node;
    $n->put("aa")->data = "AA";
    $n->put("ab")->data = "AB";
    $n->put("ba")->data = "BA";
    $n->put("bb")->data = "BB";
    $n->put("aaa")->data = "AAA";
    is_deeply $n->count, 5;

    is_deeply $n->find("aa") ->data, "AA";
    is_deeply $n->find("ab") ->data, "AB";
    is_deeply $n->find("ba") ->data, "BA";
    is_deeply $n->find("bb") ->data, "BB";
    is_deeply $n->find("aaa")->data, "AAA";


    is_deeply [map {[$_->key, $_->data]} $n->traverse],  # 𝗘𝘅𝗮𝗺𝗽𝗹𝗲

     [["aa",  "AA"],
      ["aaa", "AAA"],
      ["ab",  "AB"],
      ["ba",  "BA"],
      ["bb",  "BB"]];

    ok  $n->find("a");
    ok !$n->find("a")->data;
    ok  $n->find("b");
    ok !$n->find("b")->data;
    ok !$n->find("c");

    ok $n->find("aa")->delete;  ok  $n->find("aa");  is_deeply $n->count, 4;
    ok $n->find("ab")->delete;  ok !$n->find("ab");  is_deeply $n->count, 3;
    ok $n->find("ba")->delete;  ok !$n->find("ba");  is_deeply $n->count, 2;
    ok $n->find("bb")->delete;  ok !$n->find("bb");  is_deeply $n->count, 1;

    ok  $n->find("a");
    ok !$n->find("b");

    ok $n->find("aaa")->delete; ok !$n->find("aaa"); is_deeply $n->count, 0;
    ok  !$n->find("a");
   }



=head1 Index


1 L - Count the nodes addressed in the specified tree

2 L - Remove a node from a tree

3 L - Find a key in a tree - return its node if such a node exists else undef

4 L - Return the key of a node

5 L - Create a new node

6 L - Add a key to the tree

7 L - Traverse a tree returning an array of nodes

=head1 Installation

This module is written in 100% Pure Perl and, thus, it is easy to read,
comprehend, use, modify and install via B:

  sudo cpan install Tree::Trek

=head1 Author

L

L

=head1 Copyright

Copyright (c) 2016-2021 Philip R Brenan.

This module is free software. It may be used, redistributed and/or modified
under the same terms as Perl itself.

=cut



# Tests and documentation

sub test
 {my $p = __PACKAGE__;
  binmode($_, ":utf8") for *STDOUT, *STDERR;
  return if eval "eof(${p}::DATA)";
  my $s = eval "join('', <${p}::DATA>)";
  $@ and die $@;
  eval $s;
  $@ and die $@;
  1
 }

test unless caller;

1;
# podDocumentation
__DATA__