use Bio::TreeIO;
  my $in = Bio::TreeIO->new(-format => 'nexus',
                            -file   => 't/data/adh.mb_tree.nexus');

  my $out = Bio::TreeIO->new(-format => 'pag');
  while( my $tree = $in->next_tree ) {
    $out->write_tree($tree);
  }

    my $self = shift;
    $self->SUPER::_initialize(@_);
    my ( $name_length ) = $self->_rearrange(
        [
            qw(NAME_LENGTH)
        ],
        @_
    );
    $self->name_length( defined $name_length ? $name_length : $TaxonNameLen );

    my ($self,$tree,@args) = @_;
    my ($keep_outgroup,
	$print_header,
	$no_outgroups,
	$special_node, 
	$outgroup_ancestor,
	$tree_no) = (0,0,1);
    my $name_len = $self->name_length;
    if( @args ) {
	($no_outgroups,
	 $print_header,
	 $special_node, 
	 $outgroup_ancestor,
	 $tree_no,
	 $keep_outgroup) = $self->_rearrange([qw(
                         NO_OUTGROUPS
						 PRINT_HEADER
						 SPECIAL_NODE
						 OUTGROUP_ANCESTOR
						 TREE_NO
						 KEEP_OUTGROUP
                         NAME_LENGTH)],@args);
    }
    my $newname_base = 1;

    my $root = $tree->get_root_node;
    my $eps = 0.0001;
    my (%chars,%names);
    my @nodes = $tree->get_nodes;
    my $species_ct;
    my $traitct;
    for my $node ( @nodes ) {
	if ((defined $special_node) && ($node eq $special_node)) {
	    my $no_of_tree_nodes = scalar(@nodes);
	    my $node_name = sprintf("N%d",$no_of_tree_nodes+1);
	    $names{$node->internal_id} = $node_name;

	} elsif ($node->is_Leaf) {
	    $species_ct++;

	    my $node_name = $node->id;
	    if( length($node_name)> $name_len ) {
		$self->warn( "Found a taxon name longer than $name_len letters,\n ",
			     "name will be abbreviated.\n");
		$node_name = substr($node_name, 0,$name_len);
	    } else { 
		# $node_name = sprintf("%-".$TaxonNameLen."s",$node_name);
	    }
	    $names{$node->internal_id} = $node_name;
	    my @tags = sort $node->get_all_tags;
	    my @charstates = map { ($node->get_tag_values($_))[0] } @tags;
	    $traitct = scalar @charstates unless defined $traitct;
	    $chars{$node->internal_id} = [@charstates];
	} else {
	    $names{$node->internal_id} = sprintf("N%d", $newname_base++);
	}
    }

    # generate PAG representation
    if( $print_header ) { 
	if ($keep_outgroup) {
	    $self->_print(sprintf("%d %d\n",$species_ct,$traitct));
	} else {
	    $self->_print( sprintf("%d %d\n",$species_ct-$no_outgroups,$traitct));
	}
    }

    my @ancestors = ();
    if ($keep_outgroup) {
        push @ancestors, $root;
    } else {
	push @ancestors, ( $root, $outgroup_ancestor);
    }
    my @rest;
    foreach my $node (@nodes) {
        my $i = 0;
        foreach my $anc (@ancestors) {
            if ($anc && $node eq $anc) { $i = 1; last }
        }
        unless ($i > 0) {       # root not given in PAG
            my $current_name = $names{$node->internal_id};
	    my $branch_length_to_output;
            if ($node->branch_length < $eps) {
                my $msg_nodename = $current_name;
                $msg_nodename =~ s/\s+$//;
                warn( "TREE $tree_no, node\" $msg_nodename\": branch too ",
		      "short (", $node->branch_length, "): increasing length to ",
		      "$eps\n");
                $branch_length_to_output = $eps;
            } else {
                $branch_length_to_output = $node->branch_length;
            }
	    my @line = ( $current_name,
			 $names{$node->ancestor->internal_id},
			 $branch_length_to_output);
	    
	    if ($node->is_Leaf) {		
		push @line, @{$chars{$node->internal_id}};
		$self->_print(join(',', @line),"\n");
	    } else { 
		push @rest,\@ line;
	    }
        }
    }
    for ( @rest ) { 
	$self->_print(join(',', @$_),"\n");
    }

   my ($self,@args) = @_;
   $self->throw_not_implemented();

    my ($self, $val) = @_;
    return $self->{'name_len'} = $val if $val;
    return $self->{'name_len'};
}

1;

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

  https://redmine.open-bio.org/projects/bioperl/

 Title   : new
 Usage   : my $obj = Bio::TreeIO::pag->new();
 Function: Builds a new Bio::TreeIO::pag object 
 Returns : an instance of Bio::TreeIO::pag
 Args    : -file/-fh for filename or filehandles
           -name_length for minimum name length (default = 10)