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

View of /FigKernelScripts/apply_peg_changes_to_subsystem.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (download) (as text) (annotate)
Wed Aug 10 16:25:08 2005 UTC (14 years, 9 months ago) by olson
Branch: MAIN
Process a peg update transcaction file and apply the changes to subsystem spreadsheets.

#
# Given a set of peg-update transaction log files of the form:
#
# change old-id new-id contig protein-seq
# del id
# add id contig protein-seq
#
# And a list of subsystems, modify the subsystems in place (writing backups
# as usual) to remove the deleted ids and change any occurrences of the old ids to
# the corresponding new id.
#

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

my $fig = new FIG;

my $usage = "apply_peg_changes_to_subsystem transaction-log-files... [-subsystems subsystem names]";

my(@trans_files, @subs);

my $mode = 'trans';
while (@ARGV)
{
    $_ = shift;
    if (/^-(.*)/)
    {
	if ($1 eq "subsystems")
	{
	    $mode = 'subsystems';
	}
	else
	{
	    die $usage;
	}
    }
    elsif ($mode eq 'trans')
    {
	push(@trans_files, $_);
    }
    elsif ($mode eq 'subsystems')
    {
	push(@subs, $_);
    }
}

my($trans_table, $genomes_seen) = read_trans_files(\@trans_files);

if (@subs == 0)
{
    @subs = $fig->all_subsystems();
}

for my $sub (@subs)
{
    fix_subsystem($sub, $trans_table, $genomes_seen);
}

sub fix_subsystem
{
    my($sname, $actions, $genomes_seen) = @_;

    my $sub = $fig->get_subsystem($sname);

    $sub or die "Cannot find subsystem $sname\n";

    my $modified;

    for my $genome (@$genomes_seen)
    {
	my $row_idx = $sub->get_genome_index($genome);

	next unless $row_idx;
	
	my $row = $sub->get_row($row_idx);

	my $tchange = 0;
	my $tdel = 0;

	for my $cell (@$row)
	{
	    my @ncell = ();
	    my $change = 0;
	    my $del = 0;
	    
	    for my $peg (@$cell)
	    {
		my $action = $actions->{$peg};
		if ($action eq 'del')
		{
		    $del++;
		}
		elsif ($action =~ /^fig\|(\d+\.\d+)/)
		{
		    if ($1 ne $genome)
		    {
			die "Invalid replacement $peg -> $action in $sname";
		    }
		    push(@ncell, $action);
		    $change++;
		}
		else
		{
		    push(@ncell, $peg);
		}
	    }
	    if ($change or $del)
	    {
		@$cell = @ncell;
		$tdel += $del;
		$tchange += $change;
	    }
	}

	if ($tdel or $tchange)
	{

	    if (not $modified)
	    {
		my $cur = $sub->get_curator;
		print "$sname\t$cur\n";
	    }

	    print "  $genome\t$tdel deletes\t$tchange changes\n";
	    $modified++;
	}
    }

    if ($modified)
    {
	$sub->write_subsystem(1);
    }
    
}

sub read_trans_files
{
    my($files) = @_;

    my $actions = {};
    my %genomes_seen;

    for my $file (@$files)
    {
	open(F, "<$file") or die "Cannot open transaction file $file: $!";

	while (<F>)
	{
	    chomp;
	    my($type, @args) = split(/\t/);

	    if ($type eq 'del')
	    {
		$actions->{$args[0]} = 'del';

		$genomes_seen{$fig->genome_of($args[0])}++;
	    }
	    elsif ($type eq 'change')
	    {
		$actions->{$args[0]} = $args[1];
		$genomes_seen{$fig->genome_of($args[0])}++;
	    }
	    elsif ($type eq 'add')
	    {
	    }
	    else
	    {
		die "Invalid action at $file line $.";
	    }
	}
    }
    return $actions, [sort keys %genomes_seen];
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3