Mercurial > repos > cristian > rbgoa
comparison gomwu_a.pl @ 2:5acf9dfdfa27 draft default tip
planemo upload commit 66a856bcce69986d9a6f1a39820dd9b3f4f6b0db
| author | cristian |
|---|---|
| date | Wed, 09 Nov 2022 08:57:54 +0000 |
| parents | f7287f82602f |
| children |
comparison
equal
deleted
inserted
replaced
| 1:f7287f82602f | 2:5acf9dfdfa27 |
|---|---|
| 285 foreach $go (@gos) { push @goodgo, $go unless ($gonego{$go}==1); } | 285 foreach $go (@gos) { push @goodgo, $go unless ($gonego{$go}==1); } |
| 286 @gos=@goodgo; | 286 @gos=@goodgo; |
| 287 | 287 |
| 288 ################################ | 288 ################################ |
| 289 | 289 |
| 290 #warn "comparing categories...\n"; | 290 #warn "comparing categories...\n"; |
| 291 #my $clfile="cl_".$inname31; | 291 #my $clfile="cl_".$inname31; |
| 292 #if($dones!~/ $clfile /) { | 292 #if($dones!~/ $clfile /) { |
| 293 | 293 |
| 294 use List::Util qw[min max]; | 294 use List::Util qw[min max]; |
| 295 for ($g1=0;$g1<=$#gos;$g1++){ | 295 for ($g1=0;$g1<=$#gos;$g1++){ |
| 296 my $go=@gos[$g1]; | 296 my $go=@gos[$g1]; |
| 297 next if ($gonego{$go}==1); | 297 next if ($gonego{$go}==1); |
| 298 #warn "----------------\n$go $desc{$go} level $level{$go}\n"; | 298 #warn "----------------\n$go $desc{$go} level $level{$go}\n"; |
| 299 my $goos=$go; | 299 my $goos=$go; |
| 300 my $lev=$level{$go}; | 300 my $lev=$level{$go}; |
| 301 my $dsc=$desc{$go}; | 301 my $dsc=$desc{$go}; |
| 302 for ($g2=$g1+1;$g2<=$#gos;$g2++){ | 302 for ($g2=$g1+1;$g2<=$#gos;$g2++){ |
| 303 my $go2=@gos[$g2]; | 303 my $go2=@gos[$g2]; |
| 304 next if ($gonego{$go2}==1); | 304 next if ($gonego{$go2}==1); |
| 305 next if ($ggi{$go2}==1); | 305 next if ($ggi{$go2}==1); |
| 306 my %seen={}; | 306 my %seen={}; |
| 307 my $count=0; | 307 my $count=0; |
| 308 my @combo=(); | 308 my @combo=(); |
| 309 if ($lump<=1) { | 309 if ($lump<=1) { |
| 310 foreach $g (@{$genes{$go}},@{$genes{$go2}}){ | 310 foreach $g (@{$genes{$go}},@{$genes{$go2}}){ |
| 311 unless($seen{$g}==1 ){ | 311 unless($seen{$g}==1 ){ |
| 312 $count++; | 312 $count++; |
| 313 $seen{$g}=1; | 313 $seen{$g}=1; |
| 314 push @combo, $g; | 314 push @combo, $g; |
| 315 } | 315 } |
| 316 } | 316 } |
| 317 my $shared=$#{$genes{$go}}+1+$#{$genes{$go2}}+1-$count; | 317 my $shared=$#{$genes{$go}}+1+$#{$genes{$go2}}+1-$count; |
| 318 $overlap{$go,$go2}=min($shared/($#{$genes{$go}}+1),$shared/($#{$genes{$go2}}+1)); | 318 $overlap{$go,$go2}=min($shared/($#{$genes{$go}}+1),$shared/($#{$genes{$go2}}+1)); |
| 319 $overlap{$go2,$go}=min($shared/($#{$genes{$go}}+1),$shared/($#{$genes{$go2}}+1)); | 319 $overlap{$go2,$go}=min($shared/($#{$genes{$go}}+1),$shared/($#{$genes{$go2}}+1)); |
| 320 } | 320 } |
| 321 } | 321 } |
| 322 } | 322 } |
| 323 | 323 |
| 324 open OUT, ">$inname31" or die "gomwu_a: cannot create output $inname31\n"; | 324 open OUT, ">$inname31" or die "gomwu_a: cannot create output $inname31\n"; |
| 325 | 325 |
| 326 print {OUT} join("\t",@gos),"\n"; | 326 print {OUT} join("\t",@gos),"\n"; |
| 327 | 327 |
| 328 foreach $go (@gos) { | 328 foreach $go (@gos) { |
| 329 $overlap{$go,$go}=1; | 329 $overlap{$go,$go}=1; |
| 330 foreach $go2 (@gos){ | 330 foreach $go2 (@gos){ |
| 331 print {OUT} sprintf("%.3f",1-$overlap{$go,$go2});; | 331 print {OUT} sprintf("%.3f",1-$overlap{$go,$go2});; |
| 332 print {OUT} "\t" unless ($go2 eq $gos[$#gos]); | 332 print {OUT} "\t" unless ($go2 eq $gos[$#gos]); |
| 333 } | 333 } |
| 334 print {OUT} "\n"; | 334 print {OUT} "\n"; |
| 335 } | 335 } |
| 336 close OUT; | 336 close OUT; |
| 337 #} | 337 #} |
| 338 | 338 |
| 339 #print "calling clusteringGOs.R script ....\n"; | 339 #print "calling clusteringGOs.R script ....\n"; |
| 340 # my $err=`Rscript clusteringGOs.R $inname31 $cutHeight `; | 340 # my $err=`Rscript clusteringGOs.R $inname31 $cutHeight `; |
| 341 # print $err; | 341 # print $err; |