Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Re-ordering data branches in a [Tree::DAG_Node] tree

by atcroft (Abbot)
on Apr 22, 2018 at 23:07 UTC ( #1213391=perlquestion: print w/replies, xml ) Need Help??

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.

Replies are listed 'Best First'.
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'
Re: Re-ordering data branches in a [Tree::DAG_Node] tree
by tybalt89 (Prior) on Apr 23, 2018 at 02:14 UTC

    Fun little problem :)

    #!/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; }

      Why not just

      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:  <%-{-{-{-<

        Because it fails for

        my @test_data = ( 'j', # ' i', # ' h', # ' g', # ' f', # ' e', # ' d', # 'c', # ' b', # ' a', # );
Re: Re-ordering data branches in a [Tree::DAG_Node] tree
by kcott (Bishop) on Apr 23, 2018 at 10:36 UTC

    G'day atcroft,

    Here's a method using non-destructive transliteration. It requires 5.14 (see perl5140delta: Non-destructive substitution). The guts of the solution is:

    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 ====================

    — Ken

      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
A reply falls below the community's threshold of quality. You may see it by logging in.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1213391]
Approved by planetscape
Front-paged by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (4)
As of 2020-09-24 16:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If at first I donít succeed, I Ö










    Results (134 votes). Check out past polls.

    Notices?