perl/etc/justonce/sperm/sperm_2_rsmerge.pl

   1 #!/bin/env perl
   2 use strict;
   3 use warnings;
   4 #use IO::Unread qw(unread);
   5 use Data::Dump qw(ddx);
   6
   7 die "Usage: $0 <out> <in1> [in2] [...]\n" if @ARGV < 2;
   8 my ($outf,@infs)=@ARGV;
   9
  10 my (@FH,%Dat,%Max,@Names);
  11 for my $i (@infs) {
  12         my $t;
  13         open $t,'<',$i or die "Error opening $i: $!\n";
  14         push @FH,$t;
  15 }
  16 ddx \@FH;
  17
  18 for my $i (@FH) {
  19         my $name = readline $i;
  20         $name =~ s/^# //;
  21         chomp $name;
  22         push @Names,$name;
  23         my $chr = '][';
  24         my $zeroPos=0;
  25         while (<$i>) {
  26                 if (/^\[(\w+)\]$/) {
  27                         $chr = $1;
  28                         $chr =~ s/^chr//i;
  29                         $zeroPos=0;
  30                         next;
  31                 }
  32                 unless ($chr eq '][') {
  33                         my $v = (split /\s+/)[0];
  34                         $Dat{$chr}[$zeroPos]{$name} = $v;
  35                         $Max{$chr} = $v if (defined $Max{$chr}) ? $Max{$chr} < $v : 1;
  36                         ++$zeroPos;
  37                 }
  38         }
  39 }
  40 ddx \%Dat;
  41 ddx \%Max;
  42
  43 close $_ for @FH;
  44
  45 open OUT,'>',$outf or die "Error opening $outf: $!\n";
  46 print OUT join("\t",'Chr','Pos',@Names),"\n";
  47 for my $chr (sort { "$a$b"=~/^\d+$/ ? $a<=>$b : $a cmp $b } keys %Dat) {
  48         my $ArrayRef = $Dat{$chr};
  49         for my $zeroPos ( 0 .. $#$ArrayRef ) {
  50                 print OUT join("\t",$chr,1+$zeroPos);
  51                 print OUT "\t",$ArrayRef->[$zeroPos]->{$_} for @Names;
  52                 print OUT "\n";
  53         }
  54 }
  55 close OUT;
  56
  57 __END__
  58 perl rsmerge.pl t t.out t2.out /bak/seqdata/sperm/t.out
  59 perl rsmerge.pl bamrsplot.tsv xtubam/*.ss
  60
  61 perl sperm_2_rsmerge.pl bamrsplot8.tsv ~/t/sperm/*.nstat >log
  62
  63 $ ls -1 ~/t/sperm/*.nstat
  64 /Users/Galaxy/t/sperm/ABlood-MDA.nstat
  65 /Users/Galaxy/t/sperm/Blood-MAL.nstat
  66 /Users/Galaxy/t/sperm/Sperm23-MDA.nstat
  67 /Users/Galaxy/t/sperm/Sperm24-MDA.nstat
  68 /Users/Galaxy/t/sperm/Sperm28-MDA.nstat
  69 /Users/Galaxy/t/sperm/SpermS01.nstat
  70 /Users/Galaxy/t/sperm/SpermS02.nstat
  71 /Users/Galaxy/t/sperm/SpermS03.nstat