ansaurus

Question

How can I construct a family tree with Perl?

Answer 1

+2 A:

While awaiting clarification as to what the question is, I figured seeing you're in some sort of learning institution getting given Perl related assignments, I reasoned there's no better time to introduce you to Moose and CPAN, things you really should be using in the real world.

It, and its various extensions, will make your life easier, and makes Object Oriented design more straight forward and maintainable.

#!/usr/bin/perl 
use strict;
use warnings;
use Data::Dumper;
use Moose::Autobox;
use 5.010;

sub Moose::Autobox::SCALAR::sprintf {
  my $self = shift;
  sprintf( $self, @_ );
}

{

  package Son;
  use Moose;
  use MooseX::Types::Moose qw( :all );
  use MooseX::ClassAttribute;
  use MooseX::Has::Sugar 0.0300;
  use Moose::Autobox;

  class_has 'Ancestry' => ( isa => HashRef, rw, default => sub { {} } );
  class_has 'People'   => ( isa => HashRef, rw, default => sub { {} } );
  has 'name'           => ( isa => Str,     rw, required );
  has 'father'         => ( isa => Str,     rw, required );

  sub BUILD {
    my $self = shift;
    $self->Ancestry->{ $self->name }   //= {};
    $self->Ancestry->{ $self->father } //= {};
    $self->People->{ $self->name }     //= $self;
    $self->Ancestry->{ $self->father }->{ $self->name } = $self->Ancestry->{ $self->name };
  }

  sub children {
    my $self = shift;
    $self->subtree->keys;
  }

  sub subtree {
    my $self = shift;
    $self->Ancestry->{ $self->name };
  }

  sub find_person {
    my ( $self, $name ) = @_;
    return $self->People->{$name};
  }

  sub visualise {
    my $self = shift;
    '<ul><li class="person">%s</li></ul>'->sprintf( $self->visualise_t );
  }

  sub visualise_t {
    my $self = shift;
    '%s <ul>%s</ul>'->sprintf(
      $self->name,
      $self->children->map(
        sub {
          '<li class="person">%s</li>'->sprintf( $self->find_person($_)->visualise_t );
        }
        )->join('')
    );
  }
  __PACKAGE__->meta->make_immutable;
}

my @rows = ( [ "bill", "sam" ], [ "bob", "" ], [ "jack", "sam" ], [ "jone", "mike" ], [ "mike", "bob" ], [ "sam", "bob" ], );

for (@rows) {
  Son->new(
    father => $_->at(1),
    name   => $_->at(0),
  );
}

<<'EOX'->sprintf( Son->find_person('bob')->visualise )->say;
<html>
    <head>
    <style>
        li.person { 
border: 1px solid #000; 
padding: 4px;
margin: 3px;
background-color: rgba(0,0,0,0.05);
        }
    </style>
    </head>
    <body>
    %s
    </body>
</html>
EOX

Kent Fredric 2009-07-10 02:26:19

I was just wondering if anyone had any suggestions as to how to better accomplish the task at hand. I wasn't searching for a hand out. Thanks for the Moose and CPAN lesson, though! I'm new to perl and its EXTREMELY helpful to know what is the best real world method. Thanks again.

Troy C. 2009-07-10 14:22:59

Answer 2

+1 A:

As much as I enjoyed learning from Kent Fredric's answer (see, I have barely written anything beyond simple exercises using Moose), I figure you might learn more by looking at a somewhat more traditional solution to the problem of displaying the data structure. It does not directly solve your question (I assume your question is based on a homework assignment). If the code proves to be helpful, I am sure your instructor would appreciate it if you cite any outside help you have received.

#!/usr/bin/perl

use strict;
use warnings;

my @rows = (
    [ bill => 'sam'  ],
    [ bob  => ''     ],
    [ jack => 'sam'  ],
    [ jone => 'mike' ],
    [ mike => 'bob'  ],
    [ sam  => 'bob'  ],
    [ jim  => ''     ],
    [ ali  => 'jim'  ],
);

my %father_son;

for my $pair ( @rows ) {
    push @{ $father_son{ $pair->[1] } }, $pair->[0];
}

for my $root ( @{ $father_son{''} } ) {
    print_branch($root, 0);
}

sub print_branch {
    my ($branch, $level) = @_;
    print "\t" x $level, $branch, "\n";
    if ( exists $father_son{$branch} ) {
        for my $next_branch ( @{ $father_son{$branch} } ) {
            print_branch($next_branch, $level + 1);
        }
    }
    return;
}

__END__

Output:

C:\Temp> tkl
bob
        mike
                jone
        sam
                bill
                jack
jim
        ali

Sinan Ünür 2009-07-10 06:30:42

This seems to be the most easy to understand for a person just learning perl (like myself). Although, I managed to piece an answer together last night, that fixed my problem. This is also a much more simple answer to my problem. Thanks! I will learn from this example!

Troy C. 2009-07-10 14:20:35

Answer 3

+2 A:

Use GraphViz. That's a lot easier than making the picture yourself.

brian d foy 2009-07-10 15:54:15

ansaurus

tags:

views:

answers:

How can I construct a family tree with Perl?

related questions