List of paths into hash array tree in Perl

﹥>﹥吖頭↗ 提交于 2019-12-05 20:00:43

I did one with a complex hash structure keeping track of already placed nodes, and then I did this one. More steps, but somewhat leaner code.

while ( <> ) {
    chomp;
    my $ref = \@dirs;
    foreach my $dir ( split /\\/ ) {
        my $i = 0;
        $i++ while ( $ref->[$i] and $ref->[$i]{name} ne $dir );
        my $r = $ref->[$i] ||= { name => $dir, subs => [] };
        $ref  = $r->{subs};
    }
}
memowe

Here's a very short approach. Note that this can only be so simple because I changed your data format to a hash of hashes which perfectly matches your tree structure. See the code below to transform the resulting structure to yours.

my $tree = {root => {}};
foreach my $input (<DATA>) { chomp $input;
    my $t = $tree;
    $t = $t->{$_} //= {} for split /\\/ => $input;
}

use Data::Dumper; print Dumper $tree;

__DATA__
C:\A
C:\B\C
D:\AB
C:\B\A
C:\B\A\C

Output:

$VAR1 = {
          'C:' => {
                    'A' => {},
                    'B' => {
                             'A' => {
                                      'C' => {}
                                    },
                             'C' => {}
                           }
                  },
          'D:' => {
                    'AB' => {}
                  }
        };

To transform this data structure into yours, simply use this code:

sub transform {
    my $tree        = shift;
    my @children    = ();
    while (my ($name, $children) = each %$tree) {
        push @children, {
            name => $name,
            subs => [ transform($children) ],
        }
    }
    return @children;
}

my $AoH_tree = {name => 'root', subs => [transform($tree)] };

Done. :) For a completely different approach with much more sugar, power and readability, but much more LOC, see my other answer.

memowe

This is a longer but much more readable and more comfortable solution. You don't have to (and probably don't want to) use this, but maybe it can help (not only you) to learn more about different approaches. It introduces a small Moo class for tree nodes which can add names recursively to itself with readable sorting and stringification methods.

Edit: for a completely different and extremely short alternative, see my other answer. I divided it up in two answers because they are completely different approaches and because this answer is already long enough. ;)

Tree class

Note this is basically no more than your nested AoHoAoH... structure - with a litte bit sugar added. ;)

# define a tree structure
package Tree;
use Moo; # activates strict && warnings
use List::Util 'first';

# name of this node
has name => (is => 'ro');

# array ref of children
has subs => (is => 'rw', isa => sub { die unless ref shift eq 'ARRAY' });

Now after the basic preparations (our objects have one scalar name and one array ref subs) we come to the main part of this answer: the recursive add_deeply method. Note that from here everything reflects the recursive nature of your data structure:

# recursively add to this tree
sub add_deeply {
    my ($self, @names)  = @_;
    my $next_name       = shift @names;

    # names empty: do nothing
    return unless defined $next_name;

    # find or create a matching tree
    my $subtree = first {$_->name eq $next_name} @{$self->subs};
    push @{$self->subs}, $subtree = Tree->new(name => $next_name, subs => [])
        unless defined $subtree;

    # recurse
    $subtree->add_deeply(@names);
}

The following two methods are not that important. Basically they are here to make the output pretty:

# sort using node names
sub sort {
    my $self = shift;
    $_->sort for @{$self->subs}; # sort my children
    $self->subs([ sort {$a->name cmp $b->name} @{$self->subs} ]); # sort me
}

# stringification
use overload '""' => \&to_string;
sub to_string {
    my $self    = shift;
    my $prefix  = shift // '';

    # prepare
    my $str = $prefix . '{TREE name: "' . $self->name . '"';

    # stringify children
    if (@{$self->subs}) {
        $str .= ", children: [\n";
        $str .= $_->to_string("    $prefix") for @{$self->subs};
        $str .= "$prefix]";
    }

    # done
    return $str . "}\n";
}

How to use this

Now comes the simple part. Just read the input (from __DATA__ here) and add_deeply:

# done with the tree structure: now use it
package main;

# parse and add names to a tree
my $tree = Tree->new(name => 'root', subs => []);
foreach my $line (<DATA>) {
    chomp $line;
    $tree->add_deeply(split /\\/ => $line);
}

# output
$tree->sort;
print $tree;

__DATA__
C:\A
C:\B\C
D:\AB
C:\B\A
C:\B\A\C

Output:

{TREE name: "root", children: [
    {TREE name: "C:", children: [
        {TREE name: "A"}
        {TREE name: "B", children: [
            {TREE name: "A", children: [
                {TREE name: "C"}
            ]}
            {TREE name: "C"}
        ]}
    ]}
    {TREE name: "D:", children: [
        {TREE name: "AB"}
    ]}
]}
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!