[Bio] / BSub / contig_to_gg Repository:
ViewVC logotype

View of /BSub/contig_to_gg

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (download) (annotate) (vendor branch)
Tue Nov 29 19:19:57 2005 UTC (13 years, 10 months ago) by olson
Branch: foo, MAIN
CVS Tags: bar, HEAD
Changes since 1.1: +0 -0 lines
New dir for B. subtilis work

use strict;
use Data::Dumper;
use FIG;

my $genome = shift @ARGV;

if (!$genome)
{
    die "usage: $0 genome\n";
}

my $fig = new FIG;

my $width = 40000;

for my $contig ($fig->all_contigs($genome))
{
    my $out = "$genome.$contig.gg";

    gen_gg($genome, $contig, $width, $out);
}

sub gen_gg
{
    my($genome, $contig, $width, $out) = @_;

    open(OUT, ">$out") or die "Cannot write $out: $!\n";
    print "Writing $out\n";
    my $len = $fig->contig_ln($genome, $contig);

    print OUT "0\t$width\n";

    my $next_color = 0;
    my %sub_color;

    for (my $start = 0; $start + $width < $len; $start += $width)
    {
	print OUT "$start\n";
	my $end = $start + $width;

	my($genes, $g_beg, $g_end) = $fig->genes_in_region($genome, $contig, $start, $end);

	for my $gene (@$genes)
	{
	    my $loc = $fig->feature_location($gene);
	    my($c, $b, $e) = $fig->boundaries_of($loc);
	    
	    my $shape;
	    
	    if ($b < $e)
	    {
		$shape = "rightArrow";
	    }
	    else
	    {
		$shape = "leftArrow";
		($b, $e) = ($e, $b);
	    }
	    
	    my($type, $peg_n) = ($gene =~ /fig\|\d+\.\d+\.(\w+)\.(\d+)$/);
	    
	    my $color = "red";
	    if ($type eq 'rna')
	    {
		$color= 'black';
	    }
	    
	    my @a = $fig->feature_aliases($gene);
	    my @gene_names = grep { /^[a-zA-Z]{4}$/ } @a;
	    if (@gene_names)
	    {
		$peg_n = $gene_names[0];
	    }
	    
	    my @subs = $fig->peg_to_subsystems($gene);
	    if (@subs)
	    {
		my $sub = $subs[0];
		if (not exists $sub_color{$sub})
		{
		    my $c = $next_color + 1;
		    $next_color = ($next_color + 1) % 20;
		    $sub_color{$sub} = "color$c";
		}
		$color = $sub_color{$sub};
	    }
	    
	    $b = $start if $b < $start;
	    $e = $end if $e > $end;
	    
	    print OUT join("\t", $b - $start, $e - $start, $shape, $color, $peg_n), "\n";
	}
	print OUT "//\n"; 
    }

    for my $sub (sort keys %sub_color)
    {
	print OUT "\n";
	print OUT join("\t", 3000, $width - 10, 'rightArrow', $sub_color{$sub}, $sub), "\n";
	print OUT "//\n";
    }
    close(OUT);
}
   


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3