[Bio] / FigKernelPackages / ExpressionDir.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/ExpressionDir.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4, Fri Jan 7 22:20:55 2011 UTC revision 1.5, Fri Jan 14 20:06:51 2011 UTC
# Line 12  Line 12 
12    
13  __PACKAGE__->mk_accessors(qw(genome_dir expr_dir genome_id));  __PACKAGE__->mk_accessors(qw(genome_dir expr_dir genome_id));
14    
15    our @probe_parsers = qw(parse_probe_format_1lq
16                            parse_probe_format_1
17                            parse_probe_format_2
18                            parse_probe_format_3);
19    
20  =head3 new  =head3 new
21    
22      my $edir = ExpressionDir->new($expr_dir);      my $edir = ExpressionDir->new($expr_dir);
# Line 94  Line 99 
99      my($self, $fig) = @_;      my($self, $fig) = @_;
100    
101      my $gdir = $fig->organism_directory($self->genome_id);      my $gdir = $fig->organism_directory($self->genome_id);
102    
103        if (! -d $gdir)
104        {
105            confess "Genome directory $gdir not found";
106        }
107    
108      copy(catfile($gdir, "contigs"), catfile($self->genome_dir, "contigs"));      copy(catfile($gdir, "contigs"), catfile($self->genome_dir, "contigs"));
109      mkdir(catfile($self->genome_dir, "Features"));      mkdir(catfile($self->genome_dir, "Features"));
110      my @pegs;      my @pegs;
# Line 150  Line 161 
161      confess "create_from_sap not yet implemented";      confess "create_from_sap not yet implemented";
162  }  }
163    
164    sub parse_probe_format_1lq
165    {
166        my($self, $in_file, $out_file) = @_;
167    
168        my($fh);
169    
170        if ($in_file !~ /\.1lq$/)
171        {
172            return undef;
173        }
174    
175        open($fh, "<", $in_file) or confess "Cannot open $in_file for reading: $!";
176    
177        my $out;
178        open($out, ">", $out_file) or confess "Cannot open $out for writing: $!";
179    
180        # Skip 3 header lines.
181        $_ = <$fh> for 1..3;
182    
183        while (defined($_ = <$fh>))
184        {
185            if ($_ =~ /(\d+)\s+(\d+)\s+([ACGT]+)\s+(-?\d+)\s/)
186            {
187                if (length($3) < 15)
188                {
189                    close($fh);
190                    close($out);
191                    confess "Bad length at line $. of $in_file";
192                    return undef;
193                }
194                next if ($4 =~ /\d+3$/); #mismatch probe
195                my($x,$y,$seq) = ($1,$2,$3);
196                $seq = scalar reverse $seq;
197                print $out "$x\_$y\t$seq\n";
198            }
199            else
200            {
201                #
202                # We expect some lines not to match.
203                #
204            }
205        }
206    
207        close($fh);
208        close($out);
209        return 1;
210    }
211    
212  sub parse_probe_format_1  sub parse_probe_format_1
213  {  {
214      my($self, $in_file, $out_file) = @_;      my($self, $in_file, $out_file) = @_;
# Line 283  Line 342 
342  {  {
343      my($self, $probes) = @_;      my($self, $probes) = @_;
344    
345      my $my_probes = catfile($self->expr_dir, "probes.in");      my($probe_suffix) = $probes =~ /(\.[^.]+)$/;
346    
347        my $my_probes = catfile($self->expr_dir, "probes.in$probe_suffix");
348    
349      copy($probes, $my_probes) or confess "Cannot copy $probes to $my_probes: $!";      copy($probes, $my_probes) or confess "Cannot copy $probes to $my_probes: $!";
350    
351      my $probes_fasta = catfile($self->expr_dir, "probes.fasta");      my $probes_fasta = catfile($self->expr_dir, "probes");
352    
353      #      #
354      # Attempt to translate probe file.      # Attempt to translate probe file.
355      #      #
356      my $success;      my $success;
357      for my $meth (qw(parse_probe_format_1 parse_probe_format_2 parse_probe_format_3))      for my $meth (@probe_parsers)
358      {      {
359          if ($self->$meth($my_probes, $probes_fasta))          if ($self->$meth($my_probes, $probes_fasta))
360          {          {
# Line 432  Line 493 
493      my $probes_always_on = catfile($self->expr_dir, "probes.always.on");      my $probes_always_on = catfile($self->expr_dir, "probes.always.on");
494      my $pegs_always_on = catfile($self->expr_dir, "pegs.always.on");      my $pegs_always_on = catfile($self->expr_dir, "pegs.always.on");
495    
   
496      $self->run([executable_for("call_coregulated_clusters_on_chromosome"), $self->expr_dir],      $self->run([executable_for("call_coregulated_clusters_on_chromosome"), $self->expr_dir],
497             { stdout => $coreg_clusters });             { stdout => $coreg_clusters });
498      $self->run([executable_for("make_coreg_conjectures_based_on_subsys"), $self->expr_dir],      $self->run([executable_for("make_coreg_conjectures_based_on_subsys"), $self->expr_dir],
# Line 442  Line 502 
502             { stdout => $merged_clusters });             { stdout => $merged_clusters });
503      $self->run([executable_for("get_ON_probes"), $self->expr_dir, $probes_always_on, $pegs_always_on]);      $self->run([executable_for("get_ON_probes"), $self->expr_dir, $probes_always_on, $pegs_always_on]);
504    
505        if (-s $probes_always_on == 0)
506        {
507            confess "No always-on probes were found";
508        }
509    
510      $self->run([executable_for("Pipeline"), $pegs_always_on, $merged_clusters, $self->expr_dir],      $self->run([executable_for("Pipeline"), $pegs_always_on, $merged_clusters, $self->expr_dir],
511             { stdout => catfile($self->expr_dir, "comments.by.Pipeline.R") });             { stdout => catfile($self->expr_dir, "comments.by.Pipeline.R") });
512    
513      $self->run([executable_for("SplitGeneSets"), $merged_clusters, $pearson_cutoff, $self->expr_dir],      $self->run([executable_for("SplitGeneSets"), $merged_clusters, $pearson_cutoff, $self->expr_dir],
514             { stdout => catfile($self->expr_dir, "split.clusters") });             { stdout => catfile($self->expr_dir, "split.clusters") });
515    
516        $self->run([executable_for("compute_atomic_regulons_for_dir"), $self->expr_dir]);
517  }  }
518    
519  sub run  sub run

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3