Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Re^2: out of order tree generation (Data::Dumper)

by LanX (Saint)
on Apr 05, 2019 at 12:48 UTC ( [id://1232190]=note: print w/replies, xml ) Need Help??


in reply to Re: out of order tree generation (Data::Dumper)
in thread out of order tree generation

more Data::Dumper trickery plus a more complicated input like demonstrated by TheDamian.

output:

Professor Amy Cubert Hermes Dwight Leela Bender Fry Zoidberg Satan Beelzebub Lucky Damien 'Satan Jr' Emacs LanX

use strict; use warnings; use Data::Dumper qw/Dumper/; use Data::Dump qw/pp/; #pp my $input = get_input(); my ( $tree, @roots ); while ( my ( $top, $second ) = each %$input ) { while ( my ( $id, $attr ) = each %$second ) { my $boss_id = $attr->{boss}; my $name = $attr->{name}; unless ($boss_id) { push @roots, $name; next; } my $boss_name = $second->{$boss_id}->{name}; $tree->{$boss_name}{$name} = $tree->{$name} //= {}; } } $Data::Dumper::Indent = 1; $Data::Dumper::Terse = 1; #$Data::Dumper::Pad = '#'; $Data::Dumper::Quotekeys = 0; #$Data::Dumper::Pair = ""; $Data::Dumper::Sortkeys = 1; my $graph = Dumper { map { $_ => $tree->{$_} } @roots }; $graph =~ s/[{},=>]//g; # delete hash symbols $graph =~ s/^\s*\n//gm; # delete empty lines print $graph; sub get_input { return { 666 => { 1 => { boss => 666, name => "Beelzebub" }, 11 => { boss => 245, name => "LanX" }, 99 => { boss => 666, name => "Damien" }, 245 => { boss => 333, name => "Emacs" }, 333 => { boss => 0, name => "Satan Jr" }, 666 => { boss => 0, name => "Satan" }, 777 => { boss => 1, name => "Lucky" }, }, 1929 => { 1 => { boss => 1929, name => "Hermes" }, 2 => { boss => 1, name => "Leela" }, 3 => { boss => 1929, name => "Amy" }, 4 => { boss => 1, name => "Zoidberg" }, 480 => { boss => 2, name => "Fry" }, 1919 => { boss => 2, name => "Bender" }, 1929 => { boss => 0, name => "Professor" }, 3968 => { boss => 1929, name => "Cubert" }, 4425 => { boss => 1, name => "Dwight" }, }, }; }

Cheers Rolf
(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1232190]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others pondering the Monastery: (7)
As of 2024-03-29 15:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found