bin/results_to_table

   1 #! /usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use List::Util qw(sum);
   7 use IO::File;
   8
   9 die "search_resultsfile" unless @ARGV == 1;
  10 my ($search_results_fn) = @ARGV;
  11
  12 my $search_results_fh = new IO::File $search_results_fn, 'r' or die "Unable to read $search_results_fn: $!";
  13
  14 # read in the search results
  15 my @results;
  16 my %name_idx;
  17 my %refseq_idx;
  18 my %databases;
  19 my %terms;
  20 while (<$search_results_fh>) {
  21      # "name","hits","rzscore","refseq","location","alias","database","terms","description","function"
  22      next if $_ =~ /^\"name\"\,/;
  23      chomp;
  24      my %record;
  25      @record{qw(name hits rzscore refseq location alias database terms description function)} = map {s/^"//; s/"$//; $_;} split /\"\,\"/;
  26      push @results,{%record};
  27      push @{$name_idx{lc($record{name})}}, $#results;
  28      foreach (map {lc($_)} split /\s*;\s*/, $record{alias}) {
  29           push @{$name_idx{$_}}, $#results;
  30      }
  31      die "Duplicate refseq at record $." if exists $refseq_idx{lc $record{refseq}};
  32      $refseq_idx{lc $record{name}} = $#results;
  33      my @terms = split '; ', $record{terms};
  34      my %term_temp;
  35      my %db_temp;
  36      my %gene_temp;
  37      my %gene_temp2;
  38      for my $term (@terms) {
  39           if ($term =~ /\[/) {
  40                my ($keyword,$database,$hits) = $term =~ /([^[]+)\[([^\]]+)\]:(\d+)/;
  41                $keyword =~ s/[-+_]/ /g;
  42                $keyword =~ s/\s*$//;
  43                $keyword =~ s/[*]//;
  44                $gene_temp{$keyword}{$database} = 1;
  45                $gene_temp2{$database}{$keyword} = 1;
  46                $databases{$database}{$keyword}{count}++;
  47                $db_temp{$database}++;
  48                $terms{$keyword}{$database}{count}++;
  49           }
  50           else {
  51                my ($keyword,$hits) = $term =~ /([^:]+):(\d+)/;
  52                $keyword =~ s/[-+_]/ /g;
  53                $keyword =~ s/\s*$//;
  54                $keyword =~ s/[*]//;
  55                $terms{$keyword}{total}{count}++;
  56           }
  57      }
  58      if (keys %gene_temp == 1) {
  59           $terms{[keys %gene_temp]->[0]}{total}{unique}++;
  60           if (keys %{$gene_temp{[keys %gene_temp]->[0]}} == 1) {
  61                $databases{total}{total}{unique}++
  62           }
  63      }
  64      if (keys %gene_temp2 == 1) {
  65           $databases{[keys %gene_temp2]->[0]}{total}{unique}++;
  66      }
  67      for my $keyword (keys %gene_temp) {
  68           if (keys %{$gene_temp{$keyword}} == 1) {
  69                $terms{$keyword}{[keys %{$gene_temp{$keyword}}]->[0]}{unique}++;
  70           }
  71      }
  72      for my $database (keys %db_temp) {
  73           $databases{$database}{total}{count}++;
  74      }
  75      $databases{total}{total}{count}++;
  76 }
  77
  78 our ($keyword,$gct,$hvt,$nct,$t) = ('Keyword','GeneCards','Harvester','NCBI','Total');
  79      format STDOUT =
  80 @<<<<<<<<<<<<<<<<<<<<<< & @>>>>>>>>>> & @>>>>>>>>>> & @>>>>>>>>>> & @>>>>>>>>>> \\
  81 $keyword,                 $gct,     $hvt,     $nct,     $t
  82 .
  83 write;
  84
  85 for $keyword (sort keys %terms) {
  86      ($gct,$hvt,$nct,$t) =
  87           map {
  88                if (not defined $_) {
  89                     '$-$';
  90                }
  91                else {
  92                     $_->{unique} ||= 0;
  93                     "$_->{count} ($_->{unique})";
  94                }
  95           } @{$terms{$keyword}}{qw(genecard harvester ncbi total)};
  96      write;
  97 }
  98
  99 $keyword = 'Total';
 100 ($gct,$hvt,$nct,$t) =
 101      map {
 102           if (not defined $_) {
 103                '$-$';
 104           }
 105           else {
 106                $_->{unique} ||= 0;
 107                "$_->{count} ($_->{unique})";
 108           }
 109      } map {$_->{total}} @databases{qw(genecard harvester ncbi total)};
 110 #($gct,$hvt,$nct,$t) = map {$_->{total}} @databases{qw(genecard harvester ncbi total)};
 111 write;