R/FGI/fm2/cpi.pl

   1 $_=<DATA>;
   2 chomp;
   3 my @id = split /\t/,$_;
   4 #print "@id\n";
   5 my $cpi;
   6
   7 sub s2a($) {
   8         my @x = split '',@_[0];
   9         my %hash;
  10         $hash{$_}++ for (@x);
  11         @ks = sort keys %hash;
  12         $r = join('',@ks);
  13         return $r,length($r);
  14 }
  15 my $cpi = 1;
  16 while(<DATA>) {
  17         chomp;
  18         s/\///g;
  19         my ($gF,$gM,$gC) = split /\t/,$_;
  20         my ($F,$Fl) = s2a($gF);
  21         my ($M,$Ml) = s2a($gM);
  22         my ($C,$Cl) = s2a($gC);
  23         my $pi=10**(-5);
  24         my $type='NA';
  25         if ($F eq $M and $M eq $C and $Fl==1) {
  26                 $pi = 2;
  27                 $type = "PPP 1/p";
  28         } elsif ($F ne $M and $Fl+$Ml==2 and $Cl==2 and $C =~ /$F/ and $C=~/$M/) {
  29                 $pi = 2;
  30                 $type = "P PQ Q 1/q";
  31         } elsif ($C eq $M and $Cl+$Ml==2 and $Fl==2 and $F=~/$M/) {
  32                 $pi = 1;
  33                 $type = "P P PQ 1/2p";
  34         } elsif ($Ml==1 and $Cl==2 and $Fl==2 and $C=~/$M/) {
  35                 $pi = 1;
  36                 $type = "P PQ PQ/QR 1/2q";
  37         } elsif ($Ml==2) {
  38                 if ($Cl==1 and $M=~/$C/) {
  39                         if ($Fl==1 and $F=~/$C/) {
  40                                 $pi = 2;
  41                                 $type = "PQ QQ QQ 1/q";
  42                         } elsif ($Fl==2 and $F=~/$C/) {
  43                                 $pi = 1;
  44                                 $type = "PQ QQ QR 1/2q";
  45                         }
  46                 } elsif ($Cl==2) {
  47                         if ($M eq $C) {
  48                                 if ($F eq $C or $Fl==1) {
  49                                         $pi = 1;
  50                                         $type = "PQ PQ PP/QQ/PQ 1/(p+q)";
  51                                 } elsif ($Fl==2) {
  52                                         $pi = 1/2;
  53                                         $type = "PQ PQ PR 1/2(p+q)";
  54                                 }
  55                         } else {
  56                                 if ($Fl==1 and $F=~/$C/) {
  57                                         $pi = 2;
  58                                         $type = "PQ QR RR 1/r";
  59                                 } elsif ($Fl==2 and $F=~/$C/) {
  60                                         $pi = 1;
  61                                         $type = "PQ QR RS 1/2r";
  62                                 } elsif ($F eq $C) {
  63                                         $pi = 1;
  64                                         $type = "PQ PR PR 1/2r";
  65                                 }
  66                         }
  67                 }
  68         }
  69         print "($M,$C,$F)\t$pi=$type\n";
  70         $cpi *= $pi;
  71 }
  72 print $cpi,"\n";
  73
  74 __DATA__
  75 G2F     G2M     G2S
  76 G/G     G/G     G/G
  77 G/G     A/G     G/G
  78 C/C     G/C     G/C
  79 T/C     C/C     C/C
  80 A/G     A/G     A/G
  81 A/A     A/A     A/A
  82 C/T     C/C     C/C
  83 A/G     G/G     G/G
  84 G/A     G/G     G/G
  85 G/A     G/A     A/A
  86 T/T     T/T     T/T
  87 G/G     A/G     A/G
  88 T/T     T/T     T/T
  89 T/C     T/C     T/C
  90 A/A     T/T     T/A
  91 C/C     T/C     T/C
  92 C/T     C/T     C/T
  93 G/A     A/A     A/A
  94 A/T     T/T     T/T
  95 G/G     G/G     G/G
  96 G/G     A/A     A/G
  97 G/C     C/C     G/C
  98 A/G     A/G     A/G
  99 A/A     A/A     A/A
 100 T/T     T/T     T/T
 101 C/C     C/C     C/C
 102 A/A     A/A     A/A
 103 G/A     G/G     G/G
 104 A/A     T/T     T/A
 105 T/C     T/C     T/T
 106 G/G     G/G     G/G
 107 T/C     T/T     T/C
 108 G/G     G/G     G/G
 109 G/T     G/T     G/G
 110 T/T     T/T     T/T
 111 T/T     C/C     C/T
 112 G/G     C/G     G/G
 113 C/C     C/C     C/C
 114 C/C     C/C     C/C
 115 A/G     A/G     A/A
 116 T/T     T/T     T/T
 117 A/A     A/A     A/A
 118 A/A     A/C     A/C
 119 C/A     C/C     C/C
 120 T/T     C/T     T/T
 121 T/T     G/G     T/T
 122 G/T     G/G     G/T
 123 G/G     G/G     G/G
 124 G/A     G/G     G/G
 125 G/G     G/G     G/G
 126 T/A     T/A     T/T
 127 G/T     G/G     G/G
 128 T/T     T/T     T/T
 129 A/G     A/A     A/A
 130 G/A     G/A     A/A
 131 T/C     T/C     C/C
 132 G/A     G/A     A/A
 133 G/G     G/G     G/G
 134 G/T     T/T     T/T
 135 A/A     A/A     A/A
 136 G/G     T/G     G/G
 137 A/G     A/A     A/A
 138 C/G     G/G     C/G
 139 G/G     G/G     G/G
 140 G/G     G/G     G/G
 141 A/G     G/G     G/G
 142 G/G     G/G     G/G
 143 G/A     A/A     G/A
 144 C/C     G/C     C/C
 145 G/A     A/A     A/A
 146 T/C     T/C     T/T
 147 C/T     C/C     C/C
 148 C/T     C/C     C/C
 149 C/A     A/A     C/A
 150 A/A     A/A     A/A
 151 A/A     A/A     A/A
 152 C/T     C/T     C/C
 153 C/C     C/C     C/C
 154 C/C     A/C     A/C
 155 T/C     C/C     T/C
 156 C/C     C/C     C/C
 157 C/C     C/C     C/C
 158 C/C     C/C     C/C
 159 C/C     C/T     C/T
 160 C/C     T/T     T/C
 161 A/G     G/G     A/G
 162 C/C     A/A     A/A
 163 G/G     A/A     G/A
 164 A/G     A/A     A/G
 165 A/A     C/C     C/A
 166 A/T     T/T     T/T
 167 A/G     A/A     A/G
 168 T/C     T/C     C/C
 169 A/T     A/T     A/T
 170 G/G     C/C     C/G
 171 A/G     A/A     A/G
 172 T/C     T/C     C/C
 173 C/C     T/C     C/C
 174 T/T     T/C     T/T
 175 C/C     C/C     C/C
 176 T/T     T/C     T/T
 177 A/G     A/G     G/G
 178 A/C     A/C     A/A
 179 T/C     T/C     T/T
 180 A/A     G/A     A/A
 181 G/A     G/A     G/A
 182 G/A     G/A     G/A
 183 C/C     C/C     C/C
 184 T/T     T/T     T/T
 185 T/T     T/T     T/T
 186 C/C     T/T     T/C
 187 T/C     T/C     C/C
 188 G/G     G/G     G/G
 189 C/T     T/T     C/T
 190 G/G     C/G     G/G
 191 T/C     C/C     C/C
 192 T/T     T/C     T/C
 193 A/G     A/G     A/A
 194 T/A     A/A     T/A
 195 G/A     G/A     G/A
 196 G/G     A/A     G/A
 197 G/G     G/A     G/A
 198 T/A     T/T     T/A
 199 C/C     C/T     C/C
 200 C/C     C/C     C/C
 201 A/A     A/A     A/A
 202 T/T     T/T     T/T
 203 C/T     T/T     T/T
 204 T/C     T/C     T/T
 205 C/C     C/T     C/T
 206 T/C     T/T     T/T
 207 A/A     A/A     A/A
 208 G/G     A/A     A/G
 209 A/A     A/G     A/G
 210 C/T     T/T     C/T
 211 C/C     T/C     C/C
 212 T/A     A/A     T/A
 213 C/G     C/G     C/G
 214 T/T     T/T     T/T
 215 C/C     C/T     C/C
 216 A/A     T/A     A/A