cgi-bin/maps/physical/list_overgo_plate_probes.pl

   1 #!/usr/bin/perl -w
   2
   3 #  This is a script to list all the probes used in the wells of
   4 #  an overgo plate.
   5 #
   6 #  At this stage, we only offer simple functionality -- showing
   7 #  which probes have been matched and which have not, and linking
   8 #  to other pages as appropriate.
   9 #
  10 #  Funkier functionality (funktionality?) could be added to, eg.
  11 #  colour-code the probes which are instrumental in conflicted matches
  12 #  (such as those listed in tentative_overgo_associations) or to
  13 #  deal with multiple overgo_versions, etc.
  14 #
  15 ######################################################################
  16
  17 use strict;
  18 use CXGN::Page;
  19 use CXGN::DB::Physical;
  20 use CXGN::DB::Connection;
  21 use CXGN::Page::FormattingHelpers qw/page_title_html info_section_html/;
  22
  23 my $map_id = CXGN::DB::Physical::get_current_map_id();
  24
  25 # Presets.
  26 our $physical_dir = '/maps/physical/';
  27 our $baclist_page = $physical_dir . 'list_bacs_by_plate.pl?by_plate=';
  28 our $overgo_stats_page = $physical_dir . 'overgo_stats.pl';
  29 our $overgo_process_page = $physical_dir . 'overgo_process_explained.pl';
  30 our $physical_map_page = '/cview/map.pl?map_id=9&amp;physical=1';
  31 our $marker_details_page = '/search/markers/markerinfo.pl?marker_id=';
  32 our $this_page = '/maps/physical/list_overgo_plate_probes.pl?plate_no=';
  33 our $plate_width = 600;
  34 our $well_width = 50;
  35 our $well_height = 30;
  36 our $sgnblue = '#ccccff';
  37 our $highlight_color = '#dd4400';
  38
  39 # Create the page.
  40 our $page = CXGN::Page->new( "List overgo plate probes", "Robert Ahrens");
  41
  42 my %params;
  43 ($params{'plate_no'},$params{'plate_id'},$params{'highlightwell'},$params{'overgo_version'})=$page->get_encoded_arguments('plate_no','plate_id','highlightwell','overgo_version');
  44
  45 if (!$params{'plate_no'} && !$params{'plate_id'}) {
  46     &list_all_plates($page);
  47 }
  48 my ($highlight_row, $highlight_col);
  49 if ($params{'highlightwell'} =~ /^([A-z])(\d+)$/) {
  50     $highlight_row = uc $1;
  51     $highlight_col = uc $2;
  52 }
  53
  54 # Connect to the db.
  55 my $dbh = CXGN::DB::Connection->new('physical');
  56
  57 # Get overgo_version.
  58 my $overgo_version = $params{'overgo_version'} || CXGN::DB::Physical::get_current_overgo_version($dbh);
  59
  60 # Count marker <--> BAC associations from overgo_associations.
  61 # NB - We're ignoring tentative associations in this iteration.  If you
  62 # want them, this is where you should add them.
  63 my @bac_assocs_by_probe_id;
  64 my $oa_sth = $dbh->prepare("SELECT overgo_probe_id, bac_id FROM overgo_associations inner join oa_plausibility as oap using(overgo_assoc_id) WHERE overgo_version=? and oap.plausible=1 AND oap.map_id=?");
  65 $oa_sth->execute($overgo_version, $map_id);
  66 while (my ($op_id, $bac_id) = $oa_sth->fetchrow_array) {
  67     $bac_assocs_by_probe_id[$op_id] ++;
  68 }
  69 $oa_sth->finish;
  70
  71 # Get the overgo_plate_id.
  72 my $plate_id = $params{'plate_id'} || CXGN::DB::Physical::get_plate_id($dbh, $params{'plate_no'});
  73 my $plate_no = $params{'plate_no'} || CXGN::DB::Physical::get_plate_number_by_plate_id($dbh, $params{'plate_id'});
  74
  75 # Get the plate information.
  76 my %plate;
  77 my $sgn = $dbh->qualify_schema('sgn');
  78 my $plate_sth = $dbh->prepare("SELECT ma.alias, ma.marker_id, pm.overgo_probe_id, pm.overgo_plate_row, pm.overgo_plate_col FROM probe_markers AS pm LEFT JOIN $sgn.marker_alias AS ma ON pm.marker_id=ma.marker_id WHERE pm.overgo_plate_id=? AND ma.preferred=true ORDER BY pm.overgo_plate_row, pm.overgo_plate_col");
  79 $plate_sth->execute($plate_id);
  80 while (my ($mrkr, $mrid, $probeid, $row, $col) = $plate_sth->fetchrow_array) {
  81     if (($row eq $highlight_row) && ($col == $highlight_col)) {
  82         $plate{$row}{$col} = "<td width=\"$well_width\" height=\"$well_height\" bgcolor=\"$highlight_color\"><a href=\"$marker_details_page$mrid\"><b>$mrkr (" . ($bac_assocs_by_probe_id[$probeid] || "0") . ")</b></a></td>\n";
  83     } else {
  84         $plate{$row}{$col} = "<td width=\"$well_width\" height=\"$well_height\"" . ($bac_assocs_by_probe_id[$probeid] ? " bgcolor='$sgnblue'><a href='$marker_details_page$mrid'>$mrkr ($bac_assocs_by_probe_id[$probeid])</a>" : "><a href=\"$marker_details_page$mrid\">$mrkr</a>") . "</td>\n";
  85     }
  86 }
  87 $plate_sth->finish;
  88
  89 # Print the page.
  90 $page->header("Overgo probes on plate $plate_no.");
  91 # Start the table and give the title.
  92 print page_title_html(qq|Overgo probes on <a href="$baclist_page$plate_no">plate $plate_no</a>|);
  93
  94 print <<EOHTML;
  95 <p>
  96 Markers which have been successfully and <a href=\"/maps/physical/overgo_process_explained.pl#plausible\">plausibly</a> matched to BACs are displayed against a <span style='background-color:$sgnblue'><b>blue</b></span> background with the number of BACs matched listed in parentheses.  Markers that are unmatched or not plausibly matched are displayed against a <b>white</b> background.
  97 </p>
  98
  99 <table summary="" border="2" align="center" width="$plate_width">
 100 EOHTML
 101
 102 my $row = 'A';
 103 my $last_row = CXGN::DB::Physical::get_last_row();
 104 while ($row ne $last_row) {
 105     print "<tr>\n";
 106     for (my $col=1; $col<=12; $col++) {
 107         #print "<td>$row:$col</td>\n";
 108         print ($plate{$row}{$col} || "<td width=\"$well_width\" height=\"$well_height\"><font color=\"#cccccc\">empty</font></td>\n");
 109     }
 110     print "</tr>\n";
 111     $row ++;
 112 }
 113 print "</table><br /><br />\n";
 114
 115 print info_section_html(title => 'Related Pages', contents => <<EOHTML);
 116 <ul>
 117 <li><a href="$baclist_page$plate_no">List all BACs which matched plate $plate_no</a></li>
 118 <li><a href="$overgo_stats_page">Overview of all processed Overgo plates.</a></li>
 119 <li><a href="$overgo_process_page">About the Overgo Plating process</a></li>
 120 <li><a href="$physical_map_page">Overview of the Physical map</a></li>
 121 </ul>
 122 EOHTML
 123 $page->footer;
 124
 125
 126 ######################################################################
 127 #
 128 #  Subroutines
 129 #
 130 ######################################################################
 131
 132
 133 sub list_all_plates ($) {
 134
 135     my ($page) = @_;
 136
 137     # Connect to the db.
 138     my $dbh = CXGN::DB::Connection->new('physical');
 139     my $sth = $dbh->prepare("SELECT DISTINCT plate_number, plate_size, empty_wells FROM overgo_plates ORDER BY plate_number");
 140     my @plates;
 141     $sth->execute;
 142     while (my ($pn, $ps, $ew) = $sth->fetchrow_array) {
 143         push @plates, "<tr>\n<td align=\"center\"><a href=\"$this_page$pn\">Plate $pn</a></td>\n";
 144         push @plates,  "<td align=\"center\">" . ($ps - $ew) . "</td></tr>\n";
 145     }
 146     $sth->finish;
 147
 148     # Throw an error if no pages are found.
 149     if (@plates == 0) {
 150         $page->error_page("No overgo plates found in the physical database.\n");
 151     }
 152
 153     # Print the page.
 154     $page->header("Overgo plates on SGN");
 155     print "<center><h2>Overgo plates on SGN</h2></center>\n";
 156     print "\nThis is a complete list of the \"designs\" (that is to say, the probe placements) of the overgo plates involved in SGN's <a href=\"$overgo_process_page\">Physical mapping project</a>.  The links below reveal the designs of the individual plates, as well as how many BACs have been successfully <i>anchored</i> against them.\n";
 157     print "\n<table summary=\"\" border=\"0\" width=\"80%\" align=\"center\">\n<tr>\n";
 158     print "<td width=\"50%\" align=\"center\"><b>Overgo probe plate</b></td>\n";
 159     print "<td width=\"50%\" align=\"center\"><b>Number of probes on plate</b></td>\n";
 160     print "</tr>\n";
 161     print @plates;
 162     print "</table>\n";
 163     print "\n<center>\n";
 164     print "<h3>Links</h3>\n";
 165     print "\n<a href=\"$overgo_process_page\">Explanation of the overgo plating process</a><br />\n";
 166     print "\n<a href=\"$physical_map_page\">Overview of the tomato physical map</a><br />\n";
 167     print "\n<a href=\"$overgo_stats_page\">View the progress of the overgo plating project</a><br />\n";
 168     print "</center>\n";
 169     $page->footer;
 170     exit;
 171
 172 }