view release on metacpan or  search on metacpan

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

	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) = @_;
# PRINT SCALE
	my $cladogram_type = $runtime_options->{'cladogram_mode'} if $runtime_options->{'show_cladogram'};
	if ( ($runtime_options->{'show_content'} ne 'Data only') && $nexusObject->get_block('trees') && (not  $cladogram_type)) {
#$lowerYbound -= $nexusG->get_histogramHeight/2 if (!($runtimeOptions{t}) && &__get_column_labels);
#$lowerYbound -= $nexusGi->get_fontHeight if ($runtimeOptions{t});
#&__print_line($lowerXbound, $lowerYbound, $lowerXbound + $amp / 10, $lowerYbound, 2);
#&__print_line($lowerXbound, $lowerYbound+5, $lowerXbound, $lowerYbound, 2);
#&__print_line($lowerXbound + $amp / 10, $lowerYbound+5, $lowerXbound + $amp / 10, $lowerYbound, 2);
	}

# PRINT TITLE	
	#my $file_param = $my_data->get_title;
	my $file_param = 'Test';
	&__draw_text($my_data,$nexusG->get_lowerXbound, $nexusG->get_fontHeight+5, uc($file_param), 'black');

# PRINT BORDER
	if ($runtime_options->{'show_border'} eq 'on' ){ # draw a box around what Postscript has determined is the plot
		my $lowerXBorder = $nexusG->get_lowerXMargin/2;
		my $lowerYBorder = $nexusG->get_lowerYMargin/2;
		my $upperXBorder = $nexusG->get_xsize - ($nexusG->get_upperXMargin/2);
		my $upperYBorder = $nexusG->get_ysize - ($nexusG->get_upperYMargin/2);
		&__draw_line($my_data,$lowerXBorder,$lowerYBorder,$upperXBorder,$lowerYBorder,'black',2);
		&__draw_line($my_data,$upperXBorder,$lowerYBorder,$upperXBorder,$upperYBorder,'black',2);
		&__draw_line($my_data,$upperXBorder,$upperYBorder,$lowerXBorder,$upperYBorder,'black',2);
		&__draw_line($my_data,$lowerXBorder,$upperYBorder,$lowerXBorder,$lowerYBorder,'black',2);
	}
}

sub __assign_ncbi_taxonomy {

	use DBI;

	my ($my_data , $taxlabels) = @_;
	my $dbh = DBI->connect("dbi:mysql:taxonomy", "root", "") || die "Can't connect to taxonomy: $DBI::errstr"; 
	my $dir_param = $runtime_options->{'directory_param'};	
	my $table_name = ($dir_param eq 'pandit') ? 'sptr_taxa' : 'cds';
	my $field_name = ($dir_param eq 'pandit') ? 'sptr_id' : 'prot_id';
	my $search_cond=($dir_param eq 'pandit') ? "= ?" : "like ?";
	my $sql_statement; 

	if($dir_param eq 'uploads') {
		$sql_statement=qq{ 
			SELECT kingdom,name
				from taxon_name 
				where name_class='scientific name' and
				taxon_id= ? limit 10};
	}else {
		$sql_statement=qq{ 
			SELECT kingdom,name
				from $table_name,taxon_name 
				where $table_name.taxon_id=taxon_name.taxon_id and 
				name_class='scientific name' and
				$table_name.$field_name $search_cond limit 10};
	}
	my $kingdom = {     	
		vertebrata	   => lc $runtime_options->{'kingdom'}->{'vertebrate'},
		invertebrata	   => lc $runtime_options->{'kingdom'}->{'invertebrate'},
		plants		   => lc $runtime_options->{'kingdom'}->{'plant'},
		fungi		   => lc $runtime_options->{'kingdom'}->{'fungi'},
		protist		   => lc $runtime_options->{'kingdom'}->{'protist'}
	};
	for my $taxlabel (@$taxlabels) {
		my $taxlabel_tmp=(split(/\//,$taxlabel))[0];
		(my $id=$taxlabel_tmp)=~s/^.*_//g;
		if ($dir_param eq 'uploads') {
## some conditions
		}else {
			chop($id) if ($dir_param eq 'NEXUS' or  $dir_param eq 'uploads');
			chop($id) if ($dir_param eq 'NEXUS' or $dir_param eq 'uploads');
			$id = ($dir_param eq 'pandit') ? $id : "$id%";
		}
		my $sth 	= $dbh->prepare($sql_statement) || die "Can't prepare statement: $DBI::errstr"; 
		my $rc 		= $sth->execute($id) || die "Can't execute statement: $DBI::errstr";
		my $num_of_rows = $sth->rows;
		my $matrix_ref  = $sth->fetchall_arrayref;
		for (my $rowNo  = 0;$rowNo < $num_of_rows;$rowNo++) {
			$my_data->set_node_color($taxlabel,$kingdom->{$$matrix_ref[0][$rowNo]});
		}	
	}

	$dbh->disconnect;
}

=head2 swap_children

 Title   : swap_children
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

sub swap_children {
	my ($self,$nodename) = @_;
	my $treename     = $self->get_name();
	my $tree         = $self->clone();
	my $swapnode     = $tree->find($nodename);
	$swapnode or die "ERROR: Node $nodename not found in $treename\n";
	my $childcount   = scalar(@{$swapnode->get_children()});
	my $tempnode     =  $swapnode->get_children()->[$childcount-1];
	for (my $index	 = $childcount-1; $index > 0; $index--) {
		print $index, " ";
		$swapnode->get_children()->[$index] = $swapnode->get_children()->[$index-1];
	}
	$swapnode->get_children()->[0] = $tempnode;
	$self = $tree->clone;
}

package MyData;
use Data::Dumper;

=head2 new

 Title   : new
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

sub new () {

	my $self = shift;
	my $RGBcolorHash = {
		white	 	=> [250,250,250],
		red		=> [250,0,0],
		green		=> [0,150,0],