annotate compStrains.pl @ 19:8ea6bb9da985 draft default tip

Uploaded
author antmarge
date Wed, 29 Mar 2017 18:04:58 -0400
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
19
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
1 #!/usr/bin/perl -w
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
2
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
3 #Margaret Antonio 16.01.13
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
4
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
5 #DESCRIPTION: Takes two aggregate.pl outputs and compares them using mean difference, pval for each
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
6 #gene. Can compare, for example, 19F in glucose and TIGR4 in glucose.
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
7 #DIFFERENT GENOMES (ie. diff. strains).
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
8 #Requires CONVERSION FILE
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
9
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
10
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
11 use Data::Dumper;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
12 use strict;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
13 use Getopt::Long;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
14 #use warnings;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
15 use File::Path;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
16 use File::Basename;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
17 use Statistics::Distributions;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
18
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
19 #ASSIGN INPUTS TO VARIABLES USING FLAGS
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
20 our ($input1,$input2,$out,$sortkey,$round,$l1,$l2,$cfile);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
21 GetOptions(
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
22 'o:s' =>\$out,
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
23 's:i' => \$sortkey,
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
24 'r:i'=> \$round,
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
25 'l1:s'=> \$l1,
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
26 'l2:s'=> \$l2,
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
27 'c:s'=> \$cfile,
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
28 'input1:s'=>\$input1,
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
29 'input2:s'=>\$input2
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
30 );
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
31
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
32
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
33 #THE @files ARRAY WILL CONTAIN INPUT FILE NAMES
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
34 my @files=($input1,$input2);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
35
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
36 #GET LABELS:
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
37 my @labels = ($l1,$l2);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
38
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
39 sub cleaner{
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
40 my $line=$_[0];
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
41 chomp($line);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
42 $line =~ s/\x0d{0,1}\x0a{0,1}\Z//s;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
43 return $line;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
44 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
45
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
46
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
47 #CHECK IF REQ. VARIABLES WERE DEFINED USING FLAGS. IF NOT THEN USE DEFAULT VALUES
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
48 if (!$out) {$out="comp.".$labels[0].$labels[1].".csv"}
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
49 if (!$round){$round='%.4f'}
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
50
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
51 #OPEN INPUTTED AGGREGATE GENE FILES AND STORE THEIR CONTENTS INTO TWO HASHES
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
52 #FILE1 GOES INTO HASH %ONE AND FILE2 GOES INTO HASH %TWO.
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
53
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
54 #FILE1 OPENING ---> %one WHERE KEY:VALUE IS GENE_ID:(GENE_ID,INSERTIONS,MEAN,ETC.)
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
55 my @header;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
56 my %one;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
57
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
58 open (F1,'<',$files[0]);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
59
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
60 #STORE COLUMN NAMES (FIRST LINE OF FILE1) FOR HEADER AND APPEND LABELS
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
61 my $head=<F1>; #the header in the file
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
62 my @cols=split(',',$head);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
63 @cols=@cols[0,1,2,3,4,5]; #get rid of blank columns
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
64 for (my $j=0;$j<scalar @cols;$j++){
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
65 $cols[$j]=cleaner($cols[$j]).'-'.$labels[0]; #mark each column name with file it comes from
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
66 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
67 push (@header,@cols);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
68
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
69 while (my $line=<F1>){
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
70 chomp $line;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
71 my @info=split(",",$line);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
72 #Only keep the first 6 columns (Ones about blanks aren't needed for comparisons)
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
73 @info=@info[0,1,2,3,4,5];
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
74 #Sometimes genes that don't have a gene name can't be blank, so fill with NA
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
75 if (!$info[5]){
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
76 $info[5]="";
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
77 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
78
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
79 $one{$info[0]}=\@info;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
80 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
81 close F1;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
82
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
83 #FILE2 OPENING ---> %two WHERE KEY:VALUE IS GENE_ID:(GENE_ID,INSERTIONS,MEAN,ETC.)
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
84
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
85 my %two;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
86 open (F2,'<',$files[1]);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
87
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
88 #STORE COLUMN NAMES (FIRST LINE OF FILE2) FOR HEADER AND APPEND LABELS
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
89 $head=<F2>; #the header in the file
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
90 @cols=split(',',$head);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
91 @cols=@cols[0,1,2,3,4,5]; #get rid of blank columns
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
92 for (my $j=0;$j<scalar @cols;$j++){
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
93 $cols[$j]=cleaner($cols[$j]).'-'.$labels[1]; #mark each column name with file it comes from
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
94 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
95 push (@header,@cols);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
96
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
97 while (my $line=<F2>){
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
98 $line = cleaner($line);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
99 my @info=split(",",$line);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
100 @info=@info[0,1,2,3,4,5];
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
101 if (!$info[5]){
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
102 $info[5]="";
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
103 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
104
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
105 $two{$info[0]}=\@info;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
106 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
107 close F2;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
108
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
109
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
110 #READ CONVERSION FILE INTO ARRAY.
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
111 #Conversion file must have strain 1 for file 1 in column 1 (index 0) and
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
112 #strain 2 for file 2 in column 2 (index 1)
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
113 #conversion file must be tab delimited with no NA fields
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
114 #If homologs (exist then take info from hashes (%one and %two) by referring to gene_id in KEY
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
115
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
116 my @all; #store all homologs in this hash
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
117 open (CONV,'<',$cfile);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
118 while (my $line=<CONV>){
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
119 $line = cleaner($line);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
120 my @genes=split("\t",$line); #Array @genes will contain two genes (SP_0000,SPT_0000)
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
121 if (scalar @genes==2 and (exists $one{$genes[0]}) and (exists $two{$genes[1]})){
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
122 my @info;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
123 my @oneArray=@{$one{$genes[0]}};
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
124 my @twoArray=@{$two{$genes[1]}};
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
125 push (@info,@oneArray,@twoArray);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
126 # Fitness values at index 1 and 7
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
127 my $diff=sprintf("$round",($info[1]-$info[7]));
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
128 my $total1=$info[2];
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
129 my $total2=$info[8];
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
130 if (!$info[3] or $info[3] eq ""){$info[3]="NA"};
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
131 if (!$info[4] or $info[4] eq ""){$info[4]="NA"};
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
132 if (!$info[9] or $info[9] eq ""){$info[9]="NA"};
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
133 if (!$info[10] or $info[10] eq ""){$info[10]="NA"};
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
134 my $sd1=$info[3];
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
135 my $se1=$info[4];
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
136 my $sd2=$info[9];
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
137 my $se2=$info[10];
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
138 my $df=$total1+$total2-2;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
139 my ($tdist,$pval);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
140 #TDIST, PVAL calculations with fail if standard dev, error, or counts are not real numbers
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
141 #or if 0 ends up in denominator
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
142 if ($sd1 eq "NA" or $sd2 eq "NA" or $total1==0 or $total2==0 or $sd1==0 or $sd2==0){
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
143 ($tdist,$pval)=("NA","NA");
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
144 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
145 else{
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
146 $tdist=sqrt((($diff)/(sqrt((($sd1**2)/$total1)+(($sd2**2)/$total2))))**2);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
147 $pval=Statistics::Distributions::tprob($df,$tdist);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
148 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
149 push (@info,$diff,$df,$tdist,$pval);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
150 push (@all,\@info);
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
151 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
152 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
153 close CONV;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
154
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
155 #SORT THE HOMOLOGS BY THE SORTKEY OR BY DEFAULT DIFFERENCE IN MEAN FITNESSES
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
156 if (!$sortkey){
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
157 $sortkey=12; #for mean difference
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
158 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
159 my @sorted = sort { $b->[$sortkey] <=> $a->[$sortkey] } @all;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
160
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
161 #FINISH THE HEADER BY ADDING COLUMN NAMES FOR MEAN-DIFF, DOF, TDIST, AND PVALUE
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
162 my $field="MeanDiff(".$labels[0].'.'.$labels[1].")";
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
163 push (@header,$field,"DOF","TDIST","PVALUE");
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
164
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
165 #PRINT MATCHED HOMOLOG INFORMATION INTO A SINGLE OUTPUT FILE
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
166 open OUT, '>',"$out";
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
167 print OUT (join(',',@header),"\n");
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
168 foreach (@sorted){
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
169 my @comparison=@{$_};
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
170 print OUT join(',',@comparison),"\n";
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
171 }
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
172
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
173 close OUT;
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
174
8ea6bb9da985 Uploaded
antmarge
parents:
diff changeset
175