& /htmlheader, title => ('D' . $det_id) &> <& modelheader &>
| Selected | Plots | The Rest |
|---|---|---|
| <& stamp_decider, dets => \@sel_stamps, ktbl => \%ktbl &> | % foreach my $stub (@plot_stubs) { <% $stub %> % } | <& stamp_decider, dets => \@unsel_stamps, ktbl => \%ktbl, hide_if_nostamp => 1 &> |
" . join(
"
\n",
sprintf('Moment Ratio: %.2f', $mr),
sprintf('PSF Quality: %.2f', $dr->{psf_qf_perfect} * $dr->{f_pos} * $dr->{ratio_all}),
sprintf('Probability: %s', $tp),
sprintf('S/N: %.2f', $det->s2n),
) . "\n";
my $q_info = "\n
" . join(
"
\n",
sprintf('pseudo1: %s', $pseudo1_sql),
sprintf('pseudo2: %s', $pseudo2_sql),
sprintf('pseudo3: %s', $pseudo3_sql),
) . "\n";
$field_info .= $dr_info;
$field_info .= $q_info;
}
# We will do two queries: one to get all detections from the field, and another
# specified by the user to discriminate. We will display two columns of stamps,
# one selected for, and all others.
if ($field) {
my @p;
if ($pseudo1_sql) { push @p, "$pseudo1_sql as pseudo1"; }
if ($pseudo2_sql) { push @p, "$pseudo2_sql as pseudo2"; }
if ($pseudo3_sql) { push @p, "$pseudo3_sql as pseudo3"; }
my $pseudo_str = '';
if (@p) {
$pseudo_str = ', ' . join(', ', @p);
}
$sql = <<"SQL";
select d.det_id det_id, d.mag as mag, d.s2n as s2n, t.probability as probability, k.known_name as known_name, dr.* $pseudo_str
from det_rawattr_v2 dr join detections d using(det_id)
left join tracklet_attrib ta using(det_id)
left join tracklets t using(tracklet_id)
left join known k using(known_id)
where d.field_id=?
SQL
$sth = $dbh->prepare($sql) or die $dbh->errstr;
$sth->execute($field_id) or die $sql;
while (my $href = $sth->fetchrow_hashref) {
$all_href->{$href->{det_id}} = $href; # save entire row
push @{$all_aref}, $href->{det_id};
$ktbl{$href->{det_id}} = $href->{known_name} if $href->{known_name};
}
$sth->finish;
}
# This is very dangerous! We are passing a query directly from a form field.
$sql = '';
if (defined($all_aref) && $det_id) {
$sql = "$SQL_STUB WHERE d.field_id=$field_id and det_id=$det_id";
$sel_aref = $dbh->selectcol_arrayref($sql);
# $sel_aref = [];
foreach my $sel_id (@{$sel_aref}) {
$sel_tbl{$sel_id} = 1; # mark as in selected column
}
}
# Now create Detection lists.
my @sel_dets = map { modcd_retrieve($inst, detId => $_) } @{$sel_aref};
my @unsel_dets = map { modcd_retrieve($inst, detId => $_) } grep { !$sel_tbl{$_} } @{$all_aref};
# Truncated lists for stamps only.
my @sel_stamps = @sel_dets;
@sel_stamps = @sel_stamps[0..$limit-1] if ($limit and scalar @sel_stamps > $limit);
my @unsel_stamps = @unsel_dets;
@unsel_stamps = @unsel_stamps[0..$limit-1] if ($limit and scalar @unsel_stamps > $limit);
# Raw attribute lists.
my @sel_raw = map { $all_href->{$_->detId} } @sel_dets;
my @unsel_raw = map { $all_href->{$_->detId} } @unsel_dets;
sub make_jquery_pairhist_stub {
# Create a Javascript JQuery stub for Flot.
my ($num, $col, $bins, $det1, $det2) = @_;
my $h;
my $x0;
my $x;
my $bw;
my $n;
my @d; # list of single det column values
my @dd; # x,y pairs for Flot
my $nd;
@d = map { $_->{$col} } @{$det1};
$h = mopslib_histogram(data => \@d, bins => $bins);
$bw = $h->{binsize};
$x0 = $h->{min};
$n = 0;
@dd = ();
$nd = scalar @{$det1} || 1;
foreach $x (@{$h->{hist}}) {
push @dd, [ $x0 + $n * $bw, $x / $nd];
$n++;
}
my $d1str = "var d${num}1 = [" .
join(',', map {'[' . $_->[0] . ', ' . $_->[1] . ']'} @dd) .
'];';
my $bw1 = $bw;
my $sel1 = sprintf 'Sel (%d)', scalar @{$det1};
@d = map { $_->{$col} } @{$det2};
$h = mopslib_histogram(data => \@d, bins => $bins);
$bw = $h->{binsize};
$x0 = $h->{min};
$n = 0;
@dd = ();
$nd = scalar @{$det2} || 1;
foreach $x (@{$h->{hist}}) {
push @dd, [ $x0 + $n * $bw, $x / $nd];
$n++;
}
my $d2str = "var d${num}2 = [" . join(',', map {'[' . $_->[0] . ', ' . $_->[1] . ']'} @dd) . ']';
my $bw2 = $bw;
my $sel2 = sprintf 'Unsel (%d)', scalar @{$det2};
my $stub = <<"STUB";
STUB return $stub; } sub make_cb { # my ($args, $param) = @_; return sprintf qq{}, ($args->{$param} ? ' checked' : ''); } sub make_scatter { # my ($cols, $idx, $x, $y) = @_; $x ||= ''; $y ||= ''; my $str1; my $str2; $str1 = qq{Scatter plot ${idx}: \n}; $str2 = qq{\n}; return "$str1 vs $str2\n"; } my $checkboxes = join("\n", map { make_cb(\%ARGS, $_) } @extcolnames). "\n"; my $scatter1 = make_scatter(\@extcolnames, 1, $scatter1_x, $scatter1_y); my $scatter2 = make_scatter(\@extcolnames, 2, $scatter2_x, $scatter2_y); my $scatter3 = make_scatter(\@extcolnames, 3, $scatter3_x, $scatter3_y); my $scatter4 = make_scatter(\@extcolnames, 4, $scatter4_x, $scatter4_y); # Create histogram JQuery stubs. my @plot_stubs; my $istub = 1; #foreach my $v (qw(mag s2n)) { # push @plot_stubs, make_jquery_pairhist_stub($istub++, $v, $bins, \@sel_dets, \@unsel_dets); #} foreach my $v (@extcolnames, qw(pseudo1 pseudo2 pseudo3)) { if ($ARGS{$v}) { push @plot_stubs, make_jquery_pairhist_stub($istub++, $v, $bins, \@sel_raw, \@unsel_raw); } } # Create scatterplot stubs. if ($scatter1_x ne 'N/A' and $scatter1_y ne 'N/A' ) { push @plot_stubs, make_jquery_scatter_stub($istub++, $scatter1_x, $scatter1_y, \@sel_raw, \@unsel_raw, 'Moment Ratio (x) vs. PSF Quality (y)'); } if ($scatter2_x ne 'N/A' and $scatter2_y ne 'N/A' ) { push @plot_stubs, make_jquery_scatter_stub($istub++, $scatter2_x, $scatter2_y, \@sel_raw, \@unsel_raw, 'Moment Ratio (x) vs. Tracklet Probability (y)'); } if ($scatter3_x ne 'N/A' and $scatter3_y ne 'N/A' ) { push @plot_stubs, make_jquery_scatter_stub($istub++, $scatter3_x, $scatter3_y, \@sel_raw, \@unsel_raw, 'Moment Ratio (x) vs. Log(S/N) (y)'); } if ($scatter4_x ne 'N/A' and $scatter4_y ne 'N/A' ) { push @plot_stubs, make_jquery_scatter_stub($istub++, $scatter4_x, $scatter4_y, \@sel_raw, \@unsel_raw); } %init>