Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

out of order tree generation

by adambot (Acolyte)
on Apr 03, 2019 at 17:09 UTC ( #1232104=perlquestion: print w/replies, xml ) Need Help??

adambot has asked for the wisdom of the Perl Monks concerning the following question:

I'm trying to create an org chart from a hash, but i have no idea where to start. I looked into trees, but what i don't understand is what happens when a grandchild is entered before a child object.

Here is my data (as dumped from Data::Dumper:

$VAR1 = { '1929' => { '3' => { 'boss' => 1929, 'name' => 'Amy' }, '4425' => { 'name' => 'Dwight', 'boss' => 1 }, '480' => { 'name' => 'Fry', 'boss' => 2 }, '1919' => { 'boss' => 2, 'name' => 'Bender' }, '1929' => { 'name' => 'Professor', 'boss' => 0 }, '3968' => { 'boss' => 1929, 'name' => 'Cubert' }, '1' => { 'boss' => 1929, 'name' => 'Hermes' }, '4' => { 'name' => 'Zoidberg', 'boss' => 1 }, '2' => { 'name' => 'Leela', 'boss' => 1 } } };
Any help is appreciated!

Replies are listed 'Best First'.
Re: out of order tree generation
by TheDamian (Priest) on Apr 03, 2019 at 21:02 UTC

    As LanX pointed out, you need to convert the bottom-up "Who is my boss" structure into a top-down "Who are my subordinates" structure, then print the resulting tree.

    For example:

    use 5.010; use strict; use warnings; # Generalized sample input data (i.e. multiple top-level groups, # each with multiple independent bosses)... my %org_chart = ( '1929' => { '3' => { 'name' => 'Amy', 'boss' => 1929, }, '4425' => { 'name' => 'Dwight', 'boss' => 1 }, '480' => { 'name' => 'Fry', 'boss' => 2 }, '1919' => { 'name' => 'Bender', 'boss' => 2, }, '1929' => { 'name' => 'Professor', 'boss' => 0 }, '3968' => { 'name' => 'Cubert', 'boss' => 1929, }, '1' => { 'name' => 'Hermes', 'boss' => 1929, }, '4' => { 'name' => 'Zoidberg', 'boss' => 1 }, '2' => { 'name' => 'Leela', 'boss' => 1 }, }, '666' => { '666' => { 'name' => 'Satan', 'boss' => 0 }, '1' => { 'name' => 'Beelzebub', 'boss' => 666 }, '777' => { 'name' => 'Lucky', 'boss' => 1 }, '99' => { 'name' => 'Damien', 'boss' => 666 }, '333' => { 'name' => 'Satan Jr', 'boss' => 0 }, '11' => { 'name' => 'Unlucky', 'boss' => 333 }, } ); # Convert each top-level group into a tree of subordinates... for my $group (values %org_chart) { for my $employee (keys %{$group}) { # Who is this employee's boss??? my $boss = $group->{$employee}{boss}; # Nothing to do if employee doesn't have a boss... next if $boss == 0; # Record that this employee is a subordinate of their boss... push @{$group->{$boss}{subordinates}}, $group->{$employee}; } } # Draw each group's org-chart (horizontally), # starting with boss-less employees... for my $group (values %org_chart) { for my $employee (values %{$group}) { # Ignore employees who have a boss... next if $employee->{boss}; # Draw the org chart for employees that don't have a boss... draw_chart($employee); } # Draw gap between groups... say ""; } # Draw each employee and their subordinates tree... sub draw_chart { my ($root_node, $level) = @_; $level //= 0; # Report the employee... say " |" x $level, "-> ", $root_node->{name}; # Recursively report their subordinates... for my $subordinate (@{$root_node->{subordinates}}) { draw_chart($subordinate, $level+1); } }
Re: out of order tree generation
by LanX (Sage) on Apr 03, 2019 at 17:14 UTC
    the second and third level has already all information bottom-up

    • Fry's boss is Leela
    • Leela's boss is the Professor

    Ignore level one.

    It really depends on the chart you wanna draw, if it's top-down you need to invert the relation.

    i.e.

    • find all subordinates of the professor (level one)
    • find subordinates of new found members
    • repeat last step till nobody left
    • draw chart

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

      the chart i'm trying to make should look like:
      Professor v-----------v------------v---------v Cubert Hermes Zoidberg Amy v----------v Dwight Leela v--------------v Fry Bender
      so as you can see, top down. To do the find, would i use the map function or is there something better?
        Personally I'd build a Hash of Arrays %children , by looping with while(my ($id, $att) = each %second_level) and pushing into $children{$boss_id}

        No code sorry this looks too much like homework, but actually you have enough now anyway ...;)

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

Re: out of order tree generation
by choroba (Archbishop) on Apr 03, 2019 at 21:14 UTC
    Here's one way to build a nested hash whose structure corresponds to the tree:
    my ($level2) = values %$VAR1; my @work = (my $root = { id => 0 }); while (@work) { my @next_work; for my $parent (@work) { my @children = grep $level2->{$_}{boss} == $parent->{id}, keys %$level2; $parent->{children} = [ map { id => $_, name => $level2->{$_}{ +name} }, @children ]; push @next_work, @{ $parent->{children} }; delete @$level2{@children}; } @work = @next_work; } use Data::Dumper; print Dumper($root);
    map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
Re: out of order tree generation
by bliako (Monsignor) on Apr 03, 2019 at 21:41 UTC

    If you are looking to transform the data you already have in the form of a hashtable in order to make searches like slaves_of('Hermes') then one way to do it would be a data structure which knows about its boss and all its slaves (if any). For example:

    my %Professor; my %Dwight; my %Leila; my %Hermes = ( # \%XYZ is a reference to hashtable XYZ # [] is an array reference 'slaves' => [\%Dwight, \%Leila], 'boss' => \%Professor ); my %Dwight = ( ... );

    Eventually you will have the top boss through which you can traverse your graph because it references everyone else directly or indirectly, assuming no mavericks.

    Should you want to make the above object-oriented then you create an object class for Worker with similar attributes like slaves and boss above and also get/set methods to access them. That might be a tad tidier and earn you some OO-kudos.

    You can also consider Prolog which was made for remembering and querying such relationships extremely well. But I doubt it will earn you any kudos at all.

    Once you have managed to put your data in a suitable data structure or use the hashtable you already have, there's nothing bad with it (just querying it, for slaves, is a bit awkward), then you want to actually render that graph you have into some kind of diagram.

    For this there's a special language called DOT. It specifies graph relations like parent/children and it is understood by many graph-drawing packages. They read DOT and output JPEG. So you need to make a function which reads your data and produces DOT the simplest version (i.e. an enumeration of boss/slave relationship) should look like this:

    graph AGRAPH { Professor -- Hermes Professor -- Amy ... Hermes -- Cubert ... }

    Now that you have your DOT-producing function you feed it to one of many programs like GraphViz to render to an image.

    However, Perl being what it is and with so many contributors, GraphViz2 has a Perl API so you can add your data directly to it by adding nodes and edges. See Project Management: Graph & Diagram for Visualizing & Analyzing Structure with GraphViz for something similar (Note: use GraphViz>>2<<). Also there is Graph::Easy which accepts nodes and edges and then outputs DOT etc.

    Note that you can convert your data to DOT or enter it into GraphViz2 directly, without the preliminary data structure I suggest. But then you would not be able to validate your data. What if there are some disconnected islands by mistake? The benefit of creating your own data structure is to be able to validate your data. Apart from abstracting and querying (like who is the boss of exactly 3 workers?). But who cares, they all got fired at the end, didn't they!

    bw, bliako

Re: out of order tree generation (Data::Dumper)
by LanX (Sage) on Apr 05, 2019 at 02:20 UTC
    Just for fun a minimalist solution using Data::Dumper to display the tree.

    Please note the options to change the display, especially Indent. :)

    use strict; use warnings; use Data::Dumper qw/Dumper/; my $input = get_input(); my $second = $input->{1929}; my ( $tree, @roots ); 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 = ' : '; print Dumper { map { $_ => $tree->{$_} } @roots }; sub get_input{ return { 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" }, }, }; }

    { Professor => { Hermes => { Dwight => {}, Zoidberg => {}, Leela => { Fry => {}, Bender => {} } }, Amy => {}, Cubert => {} } }

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

      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

Re: out of order tree generation
by QM (Parson) on Apr 05, 2019 at 08:21 UTC
    Slightly OT.

    I once did an actual org chart using graphviz (dot). I found a spreadsheet with employees and their managers. I let dot do all the work. The hardest bit was fixing up folks who didn't have a boss (contractors and consultants reported to an administrative entity on paper).

    But if the data is clean and consistent...

    I think there's a Perl module to interact with graphviz too.

    -QM
    --
    Quantum Mechanics: The dreams stuff is made of

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (6)
As of 2022-05-26 08:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you prefer to work remotely?



    Results (93 votes). Check out past polls.

    Notices?