cgi-bin/tools/seedbac/chr_sbfinder.pl

   1
   2 =head1 NAME
   3
   4 chr_sbfinder.pl - a script that finds the seed bacs on a given chromosome with some options
   5
   6 =head1 DESCRIPTION
   7
   8 chr_sbfinder.pl will display and input form if no arguments are given, or query the database for seedbacs on a given chromosome if there are arguments.
   9
  10 overgo associations are generated using the scripts in /sgn-tools/stable/physical_tools/bin/
  11
  12 computational associations are generated using parsed BLAST reports and are loaded into the database using the script in /sgn-tools/stable/physical_tools/bin/load_computational_associations.pl
  13
  14 manual associations are currently entered using SQL commands.
  15
  16 This script relies on a materialized view of the information in the tables cited above. The view is generated using the script /sgn-tools/stable/physical_tools/bin/add_bac_marker_view.pl .
  17
  18 =head1 AUTHORS
  19
  20 Lukas Mueller (lam87@cornell.edu),
  21 Beth Skwarecki (eas68@cornell.edu)
  22
  23 =cut
  24
  25 use strict;
  26
  27 use CXGN::Page;
  28 use CXGN::Map::Tools;
  29 use CXGN::DB::Connection;
  30 use CXGN::Genomic::Clone;
  31
  32 my $sbf = chr_seedbac_finder -> new();
  33
  34 $sbf -> get_args();
  35 if (!$sbf -> has_data()) {
  36     #print STDERR "No data supplied...\n";
  37     $sbf -> input_page();
  38 }
  39 else {
  40     if ($sbf->get_query("overgo")) {
  41         $sbf -> get_overgo_associations();
  42     }
  43     if ($sbf->get_query("computational")) {
  44         $sbf -> get_computational_associations();
  45     }
  46     if ($sbf->get_query("manual")) {
  47         $sbf-> get_manual_associations();
  48     }
  49     $sbf -> display_results();
  50 }
  51
  52 package chr_seedbac_finder;
  53
  54 return 1;
  55
  56 sub new {
  57     my $class = shift;
  58     my $args = {};
  59     my $self = bless $args, $class;
  60     our $page = CXGN::Page->new();
  61     $page->header();
  62     $self->{page} = $page;
  63     $self->set_dbh( CXGN::DB::Connection->new() );
  64     return $self;
  65 }
  66
  67 sub has_data {
  68     my $self = shift;
  69     if ($self->{chr}) {
  70         return 1;
  71     }
  72     else {
  73         return 0;
  74     }
  75 }
  76
  77 sub input_page {
  78     my $self=shift;
  79     #$self->{page}->header();
  80
  81     $self->input_box();
  82
  83     $self->{page}->footer();
  84 }
  85
  86 sub input_box {
  87     my $self = shift;
  88
  89     print <<HTML;
  90
  91     <h3>Seedbac finder</h3>
  92     This tool lists all anchored bacs for a given chromosome on the tomato F2-2000 map to help identify seed bacs.<br /><br />
  93     <form action="#">
  94       Chromosome: <select name="chr">
  95
  96 HTML
  97       for(my $i=1; $i<=12; $i++){
  98           print "<option value=\"$i\">$i</option>";
  99       }
 100
 101     print <<HTML;
 102       </select>
 103
 104       Marker minimal confidence: <select name="confidence">
 105       <option value=\"0\">I</option>
 106       <option value=\"1\">ILOD(2)</option>
 107       <option value=\"2\">CLOD(3)</option>
 108       <option value=\"3\">FLOD(3)</option>
 109       </select>
 110
 111       <!-- Return <input type="text" name="nr_bacs" value="all" size="3" /> BACs per anchor point. -->
 112       <br /><br />
 113       <input type="checkbox" name="show_overgo" checked="checked" /> Retrieve experimental (overgo) associations<br />
 114       <input type="checkbox" name="show_computational" /> Retrieve computational associations<br />
 115       <input type="checkbox" name="show_manual" /> Retrieve manual associations<br />
 116
 117       <br />
 118       <input type="checkbox" name="text_output" /> Output as text<br />
 119       <br />
 120       &nbsp;&nbsp;<input type="submit" value="Submit" />
 121       </form>
 122
 123 HTML
 124
 125 }
 126
 127 sub get_args {
 128     my $self = shift;
 129     my $nr_bacs_input = 0;
 130     my $chr = 0; my $confidence = -1;
 131     my ($show_overgo, $show_computational, $show_manual);
 132     ($chr, $confidence, $nr_bacs_input, $self->{text_output}, $show_overgo, $show_computational, $show_manual) = $self->{page}->get_arguments("chr", "confidence", "nr_bacs", "text_output", "show_overgo", "show_computational", "show_manual");
 133     chomp($nr_bacs_input);
 134     $self->set_chr($chr);
 135     $self->set_confidence($confidence);
 136     $self->{nr_bacs} = int($nr_bacs_input);
 137     if ($self->{nr_bacs} != $nr_bacs_input && (!($nr_bacs_input eq "all" || $nr_bacs_input eq ""))) { $self->{page}->error_page("Number of BACs returned has to be numeric."); }
 138     if ($show_overgo) { $self->add_query("overgo"); }
 139     if ($show_computational) { $self->add_query("computational"); }
 140     if ($show_manual) { $self->add_query("manual"); }
 141 }
 142
 143
 144 sub display_results {
 145     my $self = shift;
 146     if ($self->{text_output}) {
 147         $self->display_results_text();
 148     }
 149     else { $self->display_results_html(); }
 150 }
 151
 152 sub display_results_text {
 153     my $self = shift;
 154 #print "Pragma: \"no-cache\"\nContent-Disposition: filename=sequences.fasta\nContent-type: application/data\n\n";
 155     #$self->{page}->{request}->send_http_header("text/plain");
 156     print "<pre>";
 157     print $self->{text};
 158     print "</pre>";
 159
 160 }
 161
 162 sub display_results_html {
 163     my $self = shift;
 164
 165     #$self->{page}->header();
 166
 167     $self->input_box();
 168
 169     print "<br /><h3>Seedbacs for chromosome ".$self->get_chr()."</h3>";
 170
 171     print "Only unambiguous matches are shown. ";
 172     if ($self->{nr_bacs}) { print "$self->{nr_bacs} shown per anchor point."; }
 173     else { print "All BACs listed for each marker."; }
 174     print "<br />\n";
 175     #if (! @bacs) { print "No bacs found or marker does not exist.\n"; }
 176
 177     print qq { <table cellspacing="5" cellpadding="0" border="0"> };
 178     print qq { <tr><td>Marker</td><td>confidence</td><td>offset (cM)</td><td>BAC name</td><td>estimated length</td><td>contig name</td><td>contig size</td><td>top pick</td><td>type</td></tr> };
 179
 180     print $self->{html};
 181
 182     print "</table>";
 183     $self->{page}->footer();
 184
 185 }
 186
 187 sub format_html {
 188     my $self = shift;
 189     my ($marker_id, $marker_name, $confidence, $offset, $bac, $len, $name, $contigs, $type) = @_;
 190
 191     my $s = "";
 192     my $count = 0;
 193     my @confidence = ( "I", "ILOD2", "CFLOD3", "F");
 194
 195         if (!$self->{bgcolor}) { $self->{bgcolor}="#ffffff"; }
 196         my $toppick="&nbsp;";
 197         if ($count ==1) { $toppick=qq{<img src="/img/checkmark.jpg" alt="" />}; }
 198         $s .= qq { <tr bgcolor="$self->{bgcolor}"><td><a href="/search/markers/markerinfo.pl?marker_id=$marker_id">$marker_name</a> [<a href="/tools/seedbac/sbfinder.pl?marker=$marker_name">all</a>][<a href="/cview/view_chromosome.pl?chr_nr=$self->{chr}&amp;hilite=$marker_name">View</a>]</td><td align="center">$confidence[$confidence]</td><td align="center">$offset</td><td><b><a href="/maps/physical/clone_info.pl?cu_name=$bac">$bac</a></b></td><td align="center">$len</td><td align="center">$name</td><td align="center">$contigs</td><td bgcolor="#FFFFFF">$toppick</td><td>$type</td></tr> };
 199
 200     return $s;
 201 }
 202
 203 sub format_text {
 204     my $self = shift;
 205     my $marker_name = shift;
 206     my $confidence = shift;
 207     my $offset = shift;
 208     my @confidence = ( "I", "ILOD2", "CFLOD3", "F");
 209     my @bacs = @_;
 210     my $s = "";
 211     foreach my $b (@bacs) {
 212         my ($bac, $len, $name, $contigs) = split /\t/, $b;
 213         if (!$contigs) { $contigs = ""; } # avoid undefined blabla errors
 214         if (!$name) { $name = ""; }
 215         $s.= "$marker_name\t$confidence[$confidence]\t$offset\t$bac\t$len\t$name\t$contigs\n";
 216     }
 217     return $s;
 218 }
 219
 220 sub toggle_bgcolor {
 221     my $self = shift;
 222     my $color1 = "#FFFFFF";
 223     my $color2 = "#DDDDDD";
 224     my $color3 = "#FF0000";
 225     if (!$self->{bgcolor}) { $self->{bgcolor}=$color3; }
 226     if ($self->{bgcolor} eq $color1) { $self->{bgcolor} = $color2; }
 227     else { $self->{bgcolor} = $color1; }
 228
 229 }
 230
 231 sub get_overgo_associations {
 232     my $self = shift;
 233
 234     $self ->{html}.= qq { <tr><td colspan="10"><h3>Experimental (overgo) Associations</h3></td></tr> };
 235
 236     my $results = $self->get_associations("overgo");
 237
 238     foreach my $row (@$results){
 239       $self->{html}.=$self->format_html(@$row,"overgo");
 240       $self->{text}.=$self->format_text(@$row, "overgo");
 241     }
 242
 243 }
 244
 245 sub get_computational_associations {
 246     my $self = shift;
 247     my $physical = $self->get_dbh()->qualify_schema("physical");
 248     my $genomic  = $self->get_dbh()->qualify_schema("genomic");
 249     my $current_tomato_map_id = CXGN::Map::Tools::current_tomato_map_id;
 250     $self ->{html}.= qq { <tr><td colspan="10"><h3>Computational Associations</h3></td></tr> };
 251 #     my $sth = $self->get_dbh()->prepare("
 252 #        SELECT distinct(marker_alias.marker_id), max(marker_alias.alias), max(confidence_id), max(position), max(library.shortname||platenum||clone.wellrow||clone.wellcol), max(estimated_length), max('?'), 0, linkage_group.lg_order
 253 #        FROM $physical.computational_associations JOIN $genomic.clone using (clone_id)
 254 #        JOIN $genomic.library using (library_id)
 255 #        JOIN marker_alias USING (marker_id)
 256 #        JOIN marker_experiment ON ($physical.computational_associations.marker_id=marker_experiment.marker_id)
 257 #        JOIN marker_location using (location_id)
 258 #        JOIN map_version using (map_version_id)
 259 #        JOIN linkage_group ON (linkage_group.map_version_id=map_version.map_version_id)
 260 #        WHERE linkage_group.lg_name=?
 261 #          AND marker_location.confidence_id>=?
 262 #          AND map_version.map_id=$current_tomato_map_id
 263 #          AND map_version.current_version='t'
 264 #          AND marker_alias.preferred='t'
 265 #        GROUP BY marker_alias.marker_id, linkage_group.lg_order
 266 # -- ,marker_alias.alias, confidence_id, position, clone_id, estimated_length, linkage_group.lg_order, library.shortname, clone.wellrow, clone.wellcol
 267 #        ORDER BY linkage_group.lg_order"
 268 #                             );
 269
 270 #     $sth->execute($self->get_chr(), $self->get_confidence());
 271
 272     my $results = $self->get_associations("computational");
 273
 274     foreach my $result (@$results) {
 275 #       $self->{html}.="*";
 276         $self->{html}.=$self->format_html(@$result,"computational");
 277         $self->{text}.=$self->format_text(@$result,"computational");
 278
 279     }
 280 }
 281
 282 =head2 get_manual_associations
 283
 284  Usage:
 285  Desc:
 286  Ret:
 287  Args:
 288  Side Effects:
 289  Example:
 290
 291 =cut
 292
 293 sub get_manual_associations {
 294     my $self = shift;
 295
 296     $self ->{html}.= qq { <tr><td colspan="10"><h3>Manual Associations</h3></td></tr> };
 297
 298     my $results = $self->get_associations("manual");
 299
 300     foreach my $row (@$results){
 301       $self->{html}.=$self->format_html(@$row,"overgo");
 302       $self->{text}.=$self->format_text(@$row, "overgo");
 303     }
 304 }
 305
 306 =head2 function get_associations
 307
 308   Synopsis:
 309   Arguments:
 310   Returns:
 311   Side effects:
 312   Description:
 313
 314 =cut
 315
 316 sub get_associations {
 317     my $self = shift;
 318     my $association_type = shift;
 319
 320     my $physical = $self->get_dbh()->qualify_schema('physical');
 321
 322     my $MAP_ID = CXGN::Map::Tools::current_tomato_map_id();
 323     print STDERR "map_id=$MAP_ID\n";
 324
 325     my $limit_string = "";
 326     if ($self->{nr_bacs}) { $limit_string = "limit $self->{nr_bacs}"; }
 327
 328     my $query =  "SELECT distinct marker_id, alias, confidence_id, bmm.position, arizona_clone_name, estimated_length, contig_name, number_of_bacs as mc, lg.lg_order FROM physical.bac_marker_matches AS bmm join linkage_group as lg using(lg_id) WHERE confidence_id >= ? AND lg.lg_name = ? AND association_type=? ORDER BY lg.lg_order, bmm.position, alias, estimated_length desc, number_of_bacs desc, contig_name";
 329
 330     print STDERR "Now working on QUERY: $query\n";
 331     my $sth = $self->get_dbh()->prepare($query);
 332
 333     $sth->execute($self->get_confidence(), $self->get_chr(), $association_type);
 334
 335     my $results = $sth->fetchall_arrayref();
 336     return $results;
 337 }
 338
 339 =head2 function get_confidence
 340
 341   Synopsis:
 342   Arguments:
 343   Returns:
 344   Side effects:
 345   Description:
 346
 347 =cut
 348
 349 sub get_confidence {
 350     my $self=shift;
 351     return $self->{confidence};
 352 }
 353
 354 =head2 function set_confidence
 355
 356   Synopsis:
 357   Arguments:
 358   Returns:
 359   Side effects:
 360   Description:
 361
 362 =cut
 363
 364 sub set_confidence {
 365     my $self=shift;
 366     $self->{confidence}=shift;
 367 }
 368
 369 =head2 function get_chr
 370
 371   Synopsis:
 372   Arguments:
 373   Returns:
 374   Side effects:
 375   Description:
 376
 377 =cut
 378
 379 sub get_chr {
 380     my $self=shift;
 381     return $self->{chr};
 382 }
 383
 384 =head2 function set_chr
 385
 386   Synopsis:
 387   Arguments:
 388   Returns:
 389   Side effects:
 390   Description:
 391
 392 =cut
 393
 394 sub set_chr {
 395     my $self=shift;
 396     $self->{chr}=shift;
 397 }
 398
 399 =head2 function get_dbh
 400
 401   Synopsis:
 402   Arguments:
 403   Returns:
 404   Side effects:
 405   Description:
 406
 407 =cut
 408
 409 sub get_dbh {
 410     my $self=shift;
 411     return $self->{dbh};
 412 }
 413
 414 =head2 function set_dbh
 415
 416   Synopsis:
 417   Arguments:
 418   Returns:
 419   Side effects:
 420   Description:
 421
 422 =cut
 423
 424 sub set_dbh {
 425     my $self=shift;
 426     $self->{dbh}=shift;
 427 }
 428
 429 =head2 add_query
 430
 431  Usage:
 432  Desc:
 433  Ret:
 434  Args:
 435  Side Effects:
 436  Example:
 437
 438 =cut
 439
 440 sub add_query {
 441     my $self = shift;
 442     my $query_type = shift;
 443     $self->{queries}->{$query_type}=1;
 444 }
 445
 446 =head2 get_queries
 447
 448  Usage:
 449  Desc:
 450  Ret:
 451  Args:
 452  Side Effects:
 453  Example:
 454
 455 =cut
 456
 457 sub get_queries {
 458     my $self = shift;
 459     return keys (%{$self->{queries}});
 460
 461 }
 462
 463 =head2 get_query
 464
 465  Usage:
 466  Desc:
 467  Ret:
 468  Args:
 469  Side Effects:
 470  Example:
 471
 472 =cut
 473
 474 sub get_query {
 475     my $self = shift;
 476     my $query_type = shift;
 477     if (exists($self->{queries}->{$query_type}) ) {
 478         return $self->{queries}->{$query_type};
 479     }
 480     else { return undef; }
 481 }
 482
 483