1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
#!/usr/bin/env perl
use strict;
use warnings;
use lib("/usr/lib/trinityrnaseq/PerlLib/");
use CanvasXpress::Heatmap;
use CanvasXpress::PlotOnLoader;
use CanvasXpress::Line;
use Getopt::Long qw(:config no_ignore_case bundling pass_through);
use CGI;
my $usage = <<__EOUSAGE__;
#############################################################################################
#
# Required:
#
# --matrix <string> matrix (best if log2, centered)
#
# Optional:
#
# --igv_coords <string> text file, formatted: feature_name (tab) chr (tab) lend (tab) rend
#
# --cluster_samples cluster the samples in the heatmap
#
##############################################################################################
__EOUSAGE__
;
my $matrix;
my $igv_coords_file;
my $sample_clusters_flag = 0;
my $help_flag;
&GetOptions('matrix=s' => \$matrix,
'igv_coords=s' => \$igv_coords_file,
'cluster_samples' => \$sample_clusters_flag,
'help|h' => \$help_flag,
);
if ($help_flag) {
die $usage;
}
unless ($matrix) {
die $usage;
}
main: {
my $cgi = new CGI();
#print $cgi->header();
my $plot_loader_func_name = "plot_loader_$$";
print $cgi->start_html(-title => 'html matrix',
-onLoad => $plot_loader_func_name . "();",
);
my $plot_loader = new CanvasXpress::PlotOnLoader($plot_loader_func_name);
open (my $fh, $matrix) or die $!;
my $header = <$fh>;
chomp $header;
$header =~ s/^\s+//;
my %accs;
my @samples = split(/\s+/, $header);
my @values;
while (<$fh>) {
chomp;
my @x = split(/\s+/);
push (@values, [@x]);
my $acc = $x[0];
$accs{$acc} = 1;
}
close $fh;
my %inputs = ( samples => \@samples,
value_matrix => \@values,
cluster_features => 1,
cluster_samples => $sample_clusters_flag,
);
if ($igv_coords_file) {
&add_IGV_links($igv_coords_file, \%accs);
&add_click_event(\%inputs);
}
my $heatmap_obj = new CanvasXpress::Heatmap("heatmap_$$");
print $heatmap_obj->draw(%inputs, 'dendrogramSpace' => 1);
$plot_loader->add_plot($heatmap_obj);
my $line_graph_obj = new CanvasXpress::Line("line_$$");
print $line_graph_obj->draw(%inputs, 'graphOrientation' => 'vertical');
$plot_loader->add_plot($line_graph_obj);
print $plot_loader->write_plot_loader();
print $cgi->end_html();
exit(0);
}
####
sub add_IGV_links {
my ($coords_file, $accs_href) = @_;
print "<script>\n"
. " var igv_lookup = {};\n";
open (my $fh, $coords_file) or die $!;
while (<$fh>) {
chomp;
my ($acc, $chr, $lend, $rend) = split(/\t/);
## offset by 10%
my $delta = $rend - $lend + 1;
my $offset = int(0.1 * $delta);
$lend -= $offset;
if ($lend < 1) {
$lend = 1;
}
$rend += $offset;
unless ($accs_href->{$acc}) { next; }
if ($acc =~ /\'/) { next; } # sorry, aint gonna work
my $val = "$chr:$lend-$rend";
print " igv_lookup[\'$acc\'] = \'$val\';\n";
}
close $fh;
print "</script>\n";
return;
}
####
sub add_click_event {
my ($inputs_href) = @_;
$inputs_href->{events} = { 'click' => "var gene = o['y']['vars'][0];\n"
. "document.location.href=\'http://localhost:60151/goto?locus=\' + igv_lookup[gene];\n" };
return;
}
|
