[Bio] / FigKernelScripts / to_gg.pl Repository:
ViewVC logotype

View of /FigKernelScripts/to_gg.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (download) (as text) (annotate)
Tue Oct 18 17:27:30 2005 UTC (14 years, 7 months ago) by overbeek
Branch: MAIN
CVS Tags: caBIG-00-00-00
add stuff for making Paul Dunman graphs

$usage = "usage: to_gg Sets Org.abbr GG.in Legend < map.coords";

use FIG;
my $fig = new FIG;

(
 ($sets     = shift @ARGV) && open(SETS,"<$sets") &&
 ($org_abbr = shift @ARGV) && open(ORGS,"<$org_abbr") &&
 ($ggF      = shift @ARGV) && open(GG,">$ggF") &&
 ($legendF  = shift @ARGV) && open(LEGEND,">$legendF")
)
    || die $usage;

while (defined($_ = <ORGS>))
{
    if ($_ =~ /^(\d+\.\d+)\s+(\S.*\S)/)
    {
	$to_org_abbr{$1} = $2;
    }
}
close(ORGS);

if (defined($_ = <STDIN>) && ($_ =~ /^(\d+)\s+(\d+)$/))
{
    print GG $_;
}
else
{
    die "BAD: $_";
}

$maps = [];
$/ = "\n//\n";
while (defined($_ = <STDIN>))
{
    chomp;
    $map = [];
    my @lines = split(/\n/,$_);
    my $oligo_line = shift @lines;
    my($org,$contig,$beg,$end,undef) = split(/\t/,$oligo_line);
    push(@$map,$to_org_abbr{$org});

    if ($beg < $end)
    {
	push(@$map,["",$beg,$end,"rightArrow","red",""]);
    }
    else
    {
	push(@$map,["",$end,$beg,"leftArrow","red",""]);
    }

    foreach $gene_line (@lines)
    {
	($peg,$beg,$end,$aliases,$func) = split(/\t/,$gene_line);
	$peg_aliases{$peg} = [split(/,/,$aliases)];
	$peg_function{$peg} = $func;

	if ($beg < $end)
	{
	    push(@$map,[$peg,$beg,$end,"rightArrow","",""]);
	}
	else
	{
	    push(@$map,[$peg,$end,$beg,"leftArrow","",""]);
	}
    }
    push(@$maps,$map);
}
$/ = "\n";

while (defined($_ = <SETS>))
{
    chop;
    @pegs = grep { defined($peg_function{$_}) } split(/\t/,$_);
    if (@pegs > 0)
    {
	$pegs = [@pegs];
	foreach $peg (@pegs)
	{
	    $in_set{$peg} = $pegs;
	}
    }
}
close(SETS);

$next = 1;
foreach $map (@$maps)
{
    for ($i=2; ($i < @$map); $i++)
    {
	$gene = $map->[$i];
	$peg = $gene->[0];
	if (! $in_legend{$peg})
	{
	    $which = $next;
	    $next++;
	    $color = "color" . ($which+2);
	    $set = $in_set{$peg};
	    if (! $set)
	    {
		$set = [$peg];
	    }
	    $func = &pick_func($set);
	    $alias = &pick_alias($set);
	    print LEGEND join("\t",($which,$alias,$func)),"\n";
	    foreach $peg1 (@$set)
	    {
		$in_legend{$peg1} = [$which,$color];
	    }
	}
	$gene->[5] = $in_legend{$peg}->[0];
	$gene->[4] = $in_legend{$peg}->[1];
    }
}
close(LEGEND);

foreach $map (@$maps)
{
    print GG "$map->[0]\n";
    for ($i=1; ($i < @$map); $i++)
    {
	$gene = $map->[$i];
	(undef,$beg,$end,$shape,$color,$text) = @$gene;
	print GG join("\t",($beg,$end,$shape,$color,$text)),"\n";
    }
    print GG "//\n";
}

sub pick_func {
    my($set) = @_;
    my($peg,%func);

    foreach $peg (@$set)
    {
	my $f = $peg_function{$peg};

        if (! defined($f) ) { $f = "" }
	$func{$f}++;
    }
    my @funcs = sort { $func{$b} <=> $func{$a} } keys(%func);
    return (@funcs > 0) ? $funcs[0] : "";
}

sub pick_alias {
    my($set) = @_;
    my($peg,$best,$x);

    my @poss = ();
    foreach $peg (@$set)
    {
	push(@poss,@{$peg_aliases{$peg}});
    }
    $best = $set->[0];
    foreach $x (@poss)
    {
	if (&better($x,$best))
	{
	    $best = $x;
	}
    }
    return $best;
}

sub better {
    my($x,$y) = @_;

    return &sc($x) >= &sc($y);
}

sub sc {
    my($x) = @_;

    if ($x =~ /^SAV\d+$/)
    {
	return 10;
    }
    elsif ($x =~ /SAV\d+/)
    {
	return 8;
    }
    elsif ($x =~ /^SA\d+$/)
    {
	return 9;
    }
    elsif ($x =~ /^[a-z]{2,3}[A-Z]$/)
    {
	return 7;
    }
    elsif ($x =~ /^sp\|/)
    {
	return 6;
    }
    elsif ($x =~ /^uni\|/)
    {
	return 5;
    }
    elsif ($x =~ /^gi\|/)
    {
	return 4;
    }
    return 1;
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3