Bio-NEXUS

 view release on metacpan or  search on metacpan

exec/nexplot.pl  view on Meta::CPAN

		}
		if (defined $sequences{$node->{'name'}} && (! $runtimeOptions{t})) {
		   printf "\t\tcharacterfont setfont\n";
		   printf "\t\ttreemax %.2f moveto ", $y;
		   &__print_sequence($sequences{$node->{'name'}}, $color)
		}
	}
#	print "\%END LABEL\n";
}

sub __print_sequence() {
    my $sequence = shift;
    my $color = shift; 
    $color = ( defined($color) ? $color : "0 0 0" );
    $sequence = uc(&__seqForDisplay($sequence));
	# Print character table
	print  "\t\t$color setrgbcolor\n";
#	for (my $i=0; $i<((length $sequence)/10) ; $i++) {
#		print "(", substr($sequence, $i*10, 10), ") show\n";
#	}
	print "(", uc $sequence, ") show\n";
}

sub __seqForDisplay() {
	my $string = shift;
    $string =~ tr/01/.+/;
	my @tmp = split (//, $string);
	my $tmp_string = "";
	for (my $i = 0; $i <= $#tmp; $i++) {
		if ($i && (($i % $blockWidth) == 0) ) { $tmp_string .= " " . $tmp[$i] }
		else { $tmp_string .= $tmp[$i]; }
	}
	return $tmp_string;
}

exec/nexplot.pl  view on Meta::CPAN

		if ( $i && ($i % $blockWidth) == 0 ) { # char #11, #21, etc.
			$blank ++;
		}
		printf "\t\t\tletterwidth %d mul 0 moveto ", $i+$blank;
		printf "letterwidth %d mul %.2f lineto\n", $i+$blank, $height;
	}
	print "\t\t0 setgray stroke\n";
	print "\tgrestore\n";
}

sub __print_boot_strap()
{
	print "\tgsave\n";
	printf "\t\tdefaultfont setfont 0.4 0.2 0 setrgbcolor\n"; # brown
	print "\t\t/numwidth (99.99) stringwidth pop def\n";
	foreach my $node (@nodes) {
		next unless $node->get_support_value(); # print only non-zero values and only if defined in the tree
		printf "\t\t%.2f (%.2f ) stringwidth pop sub %.2f moveto ", $node->_get_xcoord(), $node->get_support_value(), $node->_get_ycoord() + 7.2;
		printf "(%.2f) show\n", $node->get_support_value();
	}
	print "\tgrestore\n";
}

sub __end_post_script()
{
	# PRINT SCALE
	if ( (! $runtimeOptions{'m'}) && $dataPresent{trees} && (!($tree->is_cladogram())) ) {
		print "\tgsave\n";
		print "\t\tdefaultfont setfont\n";
		printf "\t\t%.2f %.2f moveto\n", $lowerXbound, $fontSize*.45;
		print "\t\t(0.1 substitution/site) show\n";
		print "\tgrestore\n";
		&__print_line($lowerXbound, $fontSize + 5, $lowerXbound + $amp / 10, $fontSize + 5);
		&__print_line($lowerXbound, $fontSize + 10, $lowerXbound, $fontSize + 5);

exec/p3treeplot.pl  view on Meta::CPAN

 Title   : parse_ARGV
 Usage   : (input_filename, output_filename, charlabel_subset) = &parse_ARGV (@ARGV);
 Function: assigns certain variables based on command-line arguments
 Returns : (1) NEXUS source filename, (2) output filename to be created, 
 	   (3) reference to array of subset of introns to be plotted
 Args    : array of command-line arguments
 Comments: 

=cut

sub parse_ARGV() {
	my $inputfile = shift;
	my $intron_subset = [@_];
	unless (defined($inputfile)) {die ("Proper use is 'p3treeplot.pl nexusfilename.nex [charlabel1 charlabel2 ...]'; exclude 'charlabels' to print all introns\n");}
	my ($outputfile) = $inputfile =~ m/^(.+?)(\.nex)?$/;
	$outputfile = join (".", $outputfile, @$intron_subset, "p3", "pdf");
	return ($inputfile, $outputfile, $intron_subset);
}

=head2 read_nexus

 Title   : read_nexus
 Usage   : (character_labels, otu_objects, root_object) = &read_nexus ($NEXUSfile)
 Function: reads the relevant information from a NEXUS History Block
 Returns : references to (1) array of character labels, (2) array of otu objects, 
 	   (3) root object
 Args    : name of source NEXUS file with History Block, with path if necessary
 Comments: 

=cut

sub read_nexus() {
	my $file = shift;
	-e "$file" || die"NEXUS file: <$file> does not exist in this directory.\n";
	my $nexus = Bio::NEXUS->new($file);
	my $historyBlock = $nexus->get_block("history");
	my $otuSet = $historyBlock->get_otuset();
	my $charlabels = $otuSet->get_charlabels();
	my $otus = $otuSet->get_otus();
	my $tree = $historyBlock->get_tree();
	my $root = $tree->get_rootnode();
	return ($charlabels, $otus, $root);

lib/Bio/NEXUS/Block.pm  view on Meta::CPAN

=begin comment

# This is a placeholding method only, for blocks that do not require
# any post-parser processing (i.e., most of them)

=end comment

=cut

sub _post_processing() {
    my ($self) = @_;
    return;
}

=begin comment

 Title   : _parse_title
 Usage   : $block->_parse_title($title);
 Function: parse title, set title attribute
 Returns : none

lib/Bio/NEXUS/Tools/NexPlotter.pm  view on Meta::CPAN

		#$y2 = $y-( $nexusG->get_fontHeight/2);
		$y2 = $y;
		&__draw_text($my_data,$x1,$y2,$taxon_name,$color);
		$my_data->set_label_map_coord( $taxon_name, [$x1,$y2,$x1+length($taxon_name)*$nexusG->get_fontWidth,$y2+$nexusG->get_fontHeight] ) if $runtime_options->{'output_type'} eq 'png';
		#$areaMap.= sprintf "<area shape=rect onMouseOver=\"showtip(this,event,\'$tip\')\" onMouseOut=\"PopUpMenu2_Hide();\" coords=%d,%d,%d,%d href=\"javascript:PopUpMenu2_Set(getParam2(\'$qs\',\'%s\',\'$file_param\',\'$dir_param\',\'$highlight_params[$#h...
		$x1 += length($taxon_name) * $nexusG->get_fontWidth + $nexusG->get_fontWidth;
		&__draw_line($my_data,$x1,$y1,$x2,$y1,'gray',1) if (($x1 < $x2) && ($runtime_options->{'show_content'} ne 'Tree only') && $my_data->get_char_column_labels);
	}
}

sub __print_sequence() {
	my ($my_data, $x, $y, $sequence, $taxName, $color) = @_;
	my $block = $my_data->get_selected_char_block;
	$color = ( defined($color) ? $color : 'black' );
	my $data_type     = $block->get_format()->{'datatype'} if ($block->get_format());
	my $gap_val        = $block->get_format()->{'gap'} if ($block->get_format()->{'gap'});
	my $missing_val    = $block->get_format()->{'missing'} if ($block->get_format()->{'missing'});
	my $max_val        = $block->get_format()->{'max'} if ($block->get_format()->{'max'});
	$sequence         = uc (&__processSeqForDisplay($sequence)) if ($data_type ne 'continuous');

	my $fontWidth  = $nexusG->get_fontWidth;

lib/Bio/NEXUS/Tools/NexPlotter.pm  view on Meta::CPAN

			&__draw_text($my_data,$xnew+$frontPx,$y,uc(substr($sequence,$frontPos+int($frontPos/$blockWidth),length($sequence)-$frontPos+int($aaNum/$blockWidth)-int($frontPos/$blockWidth))),$color);

		}
	}
	else {
		&__draw_text($my_data,$xnew,$y,uc($sequence),$color);
	}
}


sub __processSeqForDisplay() {
	my $string = shift;
	$string =~ tr/01/.+/;
	my @tmp = split (//, $string);
	my $tmp_string = "";
	my $char_block_width = $nexusG->get_charLabelBlockWidth;
	$string =~ s/(.{$char_block_width})/$1 /g;
	return $string;
}

lib/Bio/NEXUS/Tools/NexPlotter.pm  view on Meta::CPAN

	}
	@sorted = sort { $a <=> $b } @sorted;
	my $sortedNum = pop @sorted;
	my $amp = $nexusG->get_TreeWidth / $sortedNum if ($sortedNum != 0); # unit of branch length
		foreach my $node (@nodes) {
			$node->_set_xcoord(($node->_get_xcoord* $amp) + $nexusG->get_lowerXbound);
			$node->_set_ycoord($node->_get_ycoord + $nexusG->get_lowerYbound);
		}
}

sub __print_inode_names() {
	my ($my_data, $nodes) = @_;
	my ($xnew,$x1, $y1);
	foreach my $node (@{$nodes}) {
		next if $node->is_otu;
		$x1 = int($node->_get_xcoord);
		$y1 = int($node->_get_ycoord);
		$xnew = $x1 + $nexusG->get_fontWidth/2;
		$xnew  += $nexusG->get_pieChartRadius* 0.5 if ($ppp_param);
		&__draw_text($my_data,$xnew, $y1,$node->get_name, 'darkgray');
	}
}
sub __print_boot_strap() {
	my ($my_data, $nodes) = @_;
	foreach my $node (@{$nodes}) {
		my $name = $node->get_name();
		next unless $node->get_support_value; # print only non-zero values and only if defined in the tree
			&__draw_text($my_data,$node->_get_xcoord - ($nexusG->get_fontWidth * 4),$node->_get_ycoord + ($nexusG->get_fontHeight)/2,$node->get_support_value,'red');
	}
}

sub __plot_scale_border_title {
	my ($my_data) = @_;