atcroft has asked for the wisdom of the Perl Monks concerning the following question:
I am working on a project where I am looking at hierarchical data, and decided to use Tree::DAG_Node after experimenting with Introduction to Tree::DAG_Node for a while. My problem at this point, however, is that I believe I need to re-order the data. Can anyone point me to an example of re-ordering the data in a Tree::DAG_Node tree?
What I mean by "re-order" is as follows. I have a set of data that I am parsing into a tree. The data is hierarchical but not position-sensitive (meaning that in what I am parsing the ordering at a particular level does not matter, just that the data is present {so b,e, and c, can as easily appear as b,c, and e}). I want to re-organize the data so that I can easily "dump" the data in a particular ordering (to diff, for example). For instance,
Original data | | Desired re-ordered data |
a
b
e
f
g
c
d
h
i
j
|
|
a
b
c
d
e
f
g
h
i
j
|
At the moment, my test code (minus a way to re-order the data) is:
#!/usr/bin/perl
use strict;
use warnings;
use Tree::DAG_Node;
$| = 1;
my @test_data = (
'a', #
' b', #
' e', #
' f', #
' g', #
' c', #
' d', #
'h', #
' i', #
' j', #
);
my $indent_width = 0;
my $idw = get_indent_width( { td => [@test_data], } );
my $nc = 0;
my $tree =
Tree::DAG_Node->new(
{ name => 'root', attributes => { nc => $nc++, top_foo => 1, }, },
);
foreach my $i ( 0 .. $#test_data ) {
my $target = $tree;
my $line = $test_data[$i];
$line =~ m/^(\s*)(.*)$/msx;
my ( $indent, $text, ) = ( length $1, $2, );
my $indent_depth = $indent / $idw;
while ($indent_depth) {
if ( $target->is_root ) {
my @daughter = $target->daughters;
$target = $daughter[-1];
}
else {
my @sister = $target->daughters;
$target = $sister[-1];
}
$indent_depth--;
}
if ( !defined $target ) {
$tree->new_daughter(
{
name => $text,
attributes => { nc => $nc++, },
},
);
next;
}
$target->new_daughter(
{
name => $text,
attributes => { nc => $nc++, },
},
);
}
# print $tree->dump_names, "\n";
$tree->walk_down(
{
callback => sub {
my $attr = $_[0]->attributes;
print sprintf "%5s %7s (%-12s): { %s }\n",
$_[0]->name,
ref $_[0]->attributes,
$_[0]->address,
join( ", ",
map { "$_ => $attr->{$_}"; }
sort { $a cmp $b } keys %{$attr}
);
}
}
);
#
# Subroutines
#
sub get_indent_width {
my ($param) = shift;
my @td = $param->{td};
my %found_indent;
foreach my $i ( 0 .. $#test_data ) {
my $line = $test_data[$i];
$line =~ m/^(\s*)(.*)$/msx;
my ( $indent, $text, ) = ( length $1, $2, );
$found_indent{$indent}++;
}
my @fi = grep { $_; } sort { $a <=> $b } keys %found_indent;
while ( scalar(@fi) > 1 ) {
my $n1 = shift @fi;
my $n2 = shift @fi;
my $n3 = gcd( sort { $a <=> $b } ( $n1, $n2, ), );
push @fi, $n3;
}
$indent_width = $fi[0];
}
sub gcd {
my ( $n1, $n2, ) = @_;
if ( $n2 == 0 ) {
return $n1;
}
return gcd( $n2, $n1 % $n2, );
}
sub lcm {
my ( $n1, $n2, ) = @_;
if ( $n1 == 0 and $n2 == 0 ) {
return 0;
}
return abs( $n1 * $n2 ) / gcd( $n1, $n2, );
}
Sample output:
root HASH (0 ): { nc => 0, top_foo => 1 }
a HASH (0:0 ): { nc => 1 }
b HASH (0:0:0 ): { nc => 2 }
e HASH (0:0:1 ): { nc => 3 }
f HASH (0:0:1:0 ): { nc => 4 }
g HASH (0:0:1:0:0 ): { nc => 5 }
c HASH (0:0:2 ): { nc => 6 }
d HASH (0:0:2:0 ): { nc => 7 }
h HASH (0:1 ): { nc => 8 }
i HASH (0:1:0 ): { nc => 9 }
j HASH (0:1:0:0 ): { nc => 10 }
If someone can point me at an example of code reordering such a tree (or suggest a better way to do what I am intending), I would greatly appreciate the assistance.
Have a great day.
Re: Re-ordering data branches in a [Tree::DAG_Node] tree
by shmem (Chancellor) on Apr 23, 2018 at 01:54 UTC
|
It looks like the container of daughters is an anonymous array, so given your 'original data' and 'desired re-ordered data' it all amounts to re-ordering the daughters array by their name. Maybe you want a method 'walk_down_sorted' or monkey-patch the module in walk_down amounting to:
--- /usr/share/perl5/Tree/DAG_Node.pm 2018-02-13 23:16:43.000000000
+ +0100
+++ /home/shmem/perl/lib/Tree/DAG_Node.pm 2018-04-23 03:46:29.60751
+5296 +0200
@@ -1661,7 +1661,7 @@
if(@daughters) {
$o->{'_depth'} += 1;
#print "Depth " , $o->{'_depth'}, "\n";
- foreach my $one (@daughters) {
+ foreach my $one (sort {$a->name cmp $b->name} @daughters) {
$one->walk_down($o) if UNIVERSAL::can($one, 'is_node');
# and if it can do "is_node", it should provide a walk_down!
}
result with that:
root HASH (0 ): { nc => 0, top_foo => 1 }
a HASH (0:0 ): { nc => 1 }
b HASH (0:0:0 ): { nc => 2 }
c HASH (0:0:2 ): { nc => 6 }
d HASH (0:0:2:0 ): { nc => 7 }
e HASH (0:0:1 ): { nc => 3 }
f HASH (0:0:1:0 ): { nc => 4 }
g HASH (0:0:1:0:0 ): { nc => 5 }
h HASH (0:1 ): { nc => 8 }
i HASH (0:1:0 ): { nc => 9 }
j HASH (0:1:0:0 ): { nc => 10 }
A sort callback for sorting daughters in walk_down would be nice to have. File an enhancement request ;-)
edit: this sorting callback should also be available while populating the 'daughters' anonymous array.
perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'
| [reply] [d/l] [select] |
Re: Re-ordering data branches in a [Tree::DAG_Node] tree
by tybalt89 (Monsignor) on Apr 23, 2018 at 02:14 UTC
|
#!/usr/bin/perl
# http://perlmonks.org/?node_id=1213391
use strict;
use warnings;
my @test_data = (
'a', #
' b', #
' e', #
' f', #
' g', #
' c', #
' d', #
'h', #
' i', #
' j', #
);
my $onestring = join '', map "$_\n", @test_data;
print $onestring, "=" x 60, "\n";
print group($onestring);
sub group
{
my @groups;
push @groups, "$1" . group("$3") while $_[0] =~ /(( *).*\n)((?:\2 +.
+*\n)*)/g;
join '', sort @groups;
}
| [reply] [d/l] |
|
c:\@Work\Perl\monks>perl -wMstrict -le
"my @test_data = (
'a',
' b',
' e',
' f',
' g',
' c',
' d',
'h',
' i',
' j',
);
print for @test_data;
print '===========';
;;
print $_->[0] for
sort { $a->[1] cmp $b->[1] }
map [ $_, m{ \w+ }xmsg ],
@test_data
;
"
a
b
e
f
g
c
d
h
i
j
===========
a
b
c
d
e
f
g
h
i
j
Give a man a fish: <%-{-{-{-<
| [reply] [d/l] [select] |
|
my @test_data = (
'j', #
' i', #
' h', #
' g', #
' f', #
' e', #
' d', #
'c', #
' b', #
' a', #
);
| [reply] [d/l] |
Re: Re-ordering data branches in a [Tree::DAG_Node] tree
by kcott (Archbishop) on Apr 23, 2018 at 10:36 UTC
|
sort { $a =~ y/ //dr cmp $b =~ y/ //dr } @data
I've tested with your OP data and tybalt's offering:
#!/usr/bin/env perl
use 5.014;
use warnings;
my @test_data = (
[ atcroft => [
'a', #
' b', #
' e', #
' f', #
' g', #
' c', #
' d', #
'h', #
' i', #
' j', #
]],
[ tybalt => [
'j', #
' i', #
' h', #
' g', #
' f', #
' e', #
' d', #
'c', #
' b', #
' a', #
]],
);
say_sorted(@$_) for @test_data;
sub say_sorted {
my ($who, $data) = @_;
say "Data from $who";
say '-' x 20;
say for @$data;
say '-' x 20;
say for sort { $a =~ y/ //dr cmp $b =~ y/ //dr } @$data;
say '=' x 20;
}
Output:
Data from atcroft
--------------------
a
b
e
f
g
c
d
h
i
j
--------------------
a
b
c
d
e
f
g
h
i
j
====================
Data from tybalt
--------------------
j
i
h
g
f
e
d
c
b
a
--------------------
a
b
c
d
e
f
g
h
i
j
====================
| [reply] [d/l] [select] |
|
My understanding is the tree structure should be preserved - only sibling nodes can be swapped to sorted order.
For instance, node 'b' is a child of node 'c' in my original data, and should still be a node of 'c' in the result.
It is not.
I think the result should be
c
b
a
j
e
d
h
g
f
i
| [reply] [d/l] |
A reply falls below the community's threshold of quality. You may see it by logging in. |
|
|