File Coverage

blib/lib/BioX/SeqUtils/Promoter/SaveTypes/RImage.pm

Criterion	Covered	Total	%
statement	3	3	100.0
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	4	4	100.0

package BioX::SeqUtils::Promoter::SaveTypes::RImage;
####################################################################
#	               Charles Stephen Embry			   #
#	            MidSouth Bioinformatics Center		   #
#	        University of Arkansas Little Rock	           #
####################################################################
use base qw(BioX::SeqUtils::Promoter::SaveTypes::Base);
use Class::Std;
use Class::Std::Utils;
use POSIX qw(ceil);
use warnings;
use strict;
use Carp;
use BioX::SeqUtils::Promoter::Sequences;
use BioX::SeqUtils::Promoter::Sequence;
use BioX::SeqUtils::Promoter::Alignment;
use BioX::SeqUtils::Promoter::Annotations::Consensus;
use BioX::SeqUtils::Promoter::Annotations;

use version; our $VERSION = qv('0.1.1');

{
        my %rcode_of  :ATTR( :get   :set   :default<''>    :init_arg );
        my %width_of  :ATTR( :get   :set   :default<''>    :init_arg );
        my %height_of  :ATTR( :get   :set   :default<''>    :init_arg );

        sub BUILD {
                my ($self, $ident, $arg_ref) = @_;
                return;
        }

        sub START {
                my ($self, $ident, $arg_ref) = @_;
       		#every pdf document will have a max of 68 character perline and 58 lines per page
		my $r_code .= 'x=c(1,68)' . "\n";
		   $r_code .= 'y=c(1,58)' . "\n";
		   #$r_code .= 'y=c(1,25)' . "\n";
		$self->set_rcode($r_code);
                return;
        }


	sub save {
                my ($self, $arg_ref) = @_;
		#sequeces object will the  parameter
		my $sequences  = defined $arg_ref->{sequences} ?  $arg_ref->{sequences} : '';

		my $x_max   = 60;
		#my $y_max   = 25;
		my $y_max   = 58;
		my $image_count = 0;
		print "Save $sequences\n";

		my @sequences = $sequences->get_objects();
		print "@sequences\n";

		#my $test_label = $sequences[0]->get_label();
		#my @sequences = values %$sequences;
		my $r_code = $self->get_rcode();
		my $seqcount = 0;
		my $test_label = $sequences[0]->get_label();
		#my $test_label = get_label($sequence[0]);

		#seen how long sequences are
		my $seqlength = $self->length({ string => $sequences[0]->get_sequence( label => $test_label) });

		my $max_block = ceil($seqlength/$x_max);

		#lots of prints and test for debugging during creation of module
		#print "@sequences\n";
		#print "seqlength is $seqlength\n";
		#my $test = ceil($test_value/$x_max);
		#print "my $max_block = ceil($seqlength/$x_max)\n";
		#my $test_value = 18;
		#print "my $test = ceil($test_value/$x_max)\n";


		my $number_seq = 0;
		foreach my $seqobjcount (@sequences) {
		#counts number of sequence objects in the sequences object
		$number_seq++;
		}

		my $slide_count = 0;
		for (my $k = 0; $k < $max_block; $k++){
			$image_count = $k;
			print "block $k\n";
			$r_code .= 'pdf(file = "/home/stephen/BioCapstone/BioX-SeqUtils-Promoter/data/block' . $k . '.pdf",onefile=TRUE,width=8,height=7,pointsize=8)' . "\n";
		   	$r_code .= 'plot(x,y,adj=0,ann=FALSE,bty="n",mai=c(0,0,0,0),oma=c(0,0,0,0),pin=c(7,10),xaxt="n",yaxt="n",xpd=NA,col=c("000000"))' . "\n";
			foreach my $seqobj (@sequences) {
				my $color_list = $seqobj->get_color_list();
				my $base_list = $seqobj->get_base_list();
				my $label = $seqobj->get_label();
				#keeps a label and its data on the same line on each document
				my $ucount = $y_max - $seqcount + $slide_count;
				$seqcount++;
				$r_code .= 'text(3,' . $ucount . ',"' . $label . '",adj=1,col=c("black"))' . "\n";
				#for ( my $i = 5; $i <= $x_max + 4; $i++ ) {
				for ( my $i = 9; $i <= $x_max + 8; $i++ ) {
					my $index = $i - 9 + ($k*$x_max);
					if($index <= $seqlength){
						my $letter = $base_list->[$index] ? $base_list->[$index] : '-';
						#print "$index\n";
						my $color = $color_list->[$index] ?  $color_list->[$index] : 'black';
						# this uses base_list and color_list from sequence objects to give every letter in sequence data a color in the PDF document
						$r_code .= 'text(' . $i . ',' . $ucount  . ',"' . $letter . '",adj=0,col=c("' . $color . '"))' . "\n";
						#print 'text(' . $i . ',' . $seqcount . ',"' . $letter . '",adj=0,col=c("' . $color . '"))' . "\n";
					}

				}


			}
				$slide_count = $slide_count + $number_seq;
			#every pdf device in turned off before each new pdf is made. Gets around the pdf device limit in R
			$r_code .= 'dev.off()' . "\n";
		}

		#$r_code .= 'dev.off()' . "\n";
		$self->set_rcode($r_code);
		open (MYFILE, '>r_code.r');
	        print MYFILE $r_code;
	        close (MYFILE);
		#runs the created R script in command line
		`R CMD BATCH r_code.r r_code.out`;
		for (my $j = 0; $j < $image_count + 1; $j++){
			#creates png files for website
			my $c_image = 'convert /home/stephen/BioCapstone/BioX-SeqUtils-Promoter/data/block' . $j . '.pdf' . ' /home/stephen/BioCapstone/BioX-SeqUtils-Promoter/data/block' . $j . '.png';
			`$c_image`;
			}

	}

	sub print { my ($self) = @_; print $self->get_rcode(); }
}

1; # Magic true value required at end of module
__END__