Parent Directory
| 
Revision Log
Revision 1.28 - (view) (download) (as text)
| 1 : | mkubal | 1.1 | package Observation; |
| 2 : | |||
| 3 : | mkubal | 1.19 | use lib '/vol/ontologies'; |
| 4 : | use DBMaster; | ||
| 5 : | |||
| 6 : | mkubal | 1.1 | require Exporter; |
| 7 : | @EXPORT_OK = qw(get_objects); | ||
| 8 : | |||
| 9 : | arodri7 | 1.16 | use FIG_Config; |
| 10 : | mkubal | 1.1 | use strict; |
| 11 : | arodri7 | 1.16 | #use warnings; |
| 12 : | arodri7 | 1.9 | use HTML; |
| 13 : | mkubal | 1.1 | |
| 14 : | 1; | ||
| 15 : | |||
| 16 : | arodri7 | 1.28 | # $Id: Observation.pm,v 1.27 2007/07/25 17:06:40 arodri7 Exp $ |
| 17 : | mkubal | 1.1 | |
| 18 : | =head1 NAME | ||
| 19 : | |||
| 20 : | Observation -- A presentation layer for observations in SEED. | ||
| 21 : | |||
| 22 : | =head1 DESCRIPTION | ||
| 23 : | |||
| 24 : | The SEED environment contains various sources of information for sequence features. The purpose of this library is to provide a | ||
| 25 : | single interface to this data. | ||
| 26 : | |||
| 27 : | The data can be used to display information for a given sequence feature (protein or other, but primarily information is computed for proteins). | ||
| 28 : | |||
| 29 : | =cut | ||
| 30 : | |||
| 31 : | =head1 BACKGROUND | ||
| 32 : | |||
| 33 : | =head2 Data incorporated in the Observations | ||
| 34 : | |||
| 35 : | As the goal of this library is to provide an integrated view, we combine diverse sources of evidence. | ||
| 36 : | |||
| 37 : | =head3 SEED core evidence | ||
| 38 : | |||
| 39 : | The core SEED data structures provided by FIG.pm. These are Similarities, BBHs and PCHs. | ||
| 40 : | |||
| 41 : | =head3 Attribute based Evidence | ||
| 42 : | |||
| 43 : | We use the SEED attribute infrastructure to store information computed by a variety of computational procedures. | ||
| 44 : | |||
| 45 : | These are e.g. InterPro hits via InterProScan (ipr), NCBI Conserved Domain Database Hits via PSSM(cdd), | ||
| 46 : | PFAM hits via HMM(pfam), SignalP results(signalp), and various others. | ||
| 47 : | |||
| 48 : | =head1 METHODS | ||
| 49 : | |||
| 50 : | The public methods this package provides are listed below: | ||
| 51 : | |||
| 52 : | |||
| 53 : | mkubal | 1.24 | =head3 context() |
| 54 : | |||
| 55 : | Returns close or diverse for purposes of displaying genomic context | ||
| 56 : | mkubal | 1.1 | |
| 57 : | =cut | ||
| 58 : | |||
| 59 : | mkubal | 1.24 | sub context { |
| 60 : | mkubal | 1.1 | my ($self) = @_; |
| 61 : | |||
| 62 : | mkubal | 1.24 | return $self->{context}; |
| 63 : | mkubal | 1.1 | } |
| 64 : | |||
| 65 : | mkubal | 1.24 | =head3 rows() |
| 66 : | mkubal | 1.1 | |
| 67 : | mkubal | 1.24 | each row in a displayed table |
| 68 : | mkubal | 1.1 | |
| 69 : | mkubal | 1.24 | =cut |
| 70 : | |||
| 71 : | sub rows { | ||
| 72 : | my ($self) = @_; | ||
| 73 : | |||
| 74 : | return $self->{rows}; | ||
| 75 : | } | ||
| 76 : | |||
| 77 : | =head3 acc() | ||
| 78 : | |||
| 79 : | A valid accession or remote ID (in the style of a db_xref) or a valid local ID (FID) in case this is supported. | ||
| 80 : | mkubal | 1.1 | |
| 81 : | =cut | ||
| 82 : | |||
| 83 : | mkubal | 1.24 | sub acc { |
| 84 : | mkubal | 1.1 | my ($self) = @_; |
| 85 : | mkubal | 1.24 | return $self->{acc}; |
| 86 : | mkubal | 1.1 | } |
| 87 : | |||
| 88 : | =head3 class() | ||
| 89 : | |||
| 90 : | The class of evidence (required). This is usually simply the name of the tool or the name of the SEED data structure. | ||
| 91 : | B<Please note> the connection of class and display_method and URL. | ||
| 92 : | mkubal | 1.7 | |
| 93 : | mkubal | 1.1 | Current valid classes are: |
| 94 : | |||
| 95 : | =over 9 | ||
| 96 : | |||
| 97 : | arodri7 | 1.9 | =item IDENTICAL (seq) |
| 98 : | |||
| 99 : | mkubal | 1.3 | =item SIM (seq) |
| 100 : | mkubal | 1.1 | |
| 101 : | mkubal | 1.3 | =item BBH (seq) |
| 102 : | mkubal | 1.1 | |
| 103 : | mkubal | 1.3 | =item PCH (fc) |
| 104 : | mkubal | 1.1 | |
| 105 : | mkubal | 1.3 | =item FIGFAM (seq) |
| 106 : | mkubal | 1.1 | |
| 107 : | mkubal | 1.3 | =item IPR (dom) |
| 108 : | mkubal | 1.1 | |
| 109 : | mkubal | 1.3 | =item CDD (dom) |
| 110 : | mkubal | 1.1 | |
| 111 : | mkubal | 1.3 | =item PFAM (dom) |
| 112 : | mkubal | 1.1 | |
| 113 : | mkubal | 1.12 | =item SIGNALP_CELLO_TMPRED (loc) |
| 114 : | mkubal | 1.1 | |
| 115 : | mkubal | 1.20 | =item PDB (seq) |
| 116 : | |||
| 117 : | mkubal | 1.3 | =item TMHMM (loc) |
| 118 : | mkubal | 1.1 | |
| 119 : | mkubal | 1.3 | =item HMMTOP (loc) |
| 120 : | mkubal | 1.1 | |
| 121 : | =back | ||
| 122 : | |||
| 123 : | =cut | ||
| 124 : | |||
| 125 : | sub class { | ||
| 126 : | my ($self) = @_; | ||
| 127 : | |||
| 128 : | return $self->{class}; | ||
| 129 : | } | ||
| 130 : | |||
| 131 : | =head3 type() | ||
| 132 : | |||
| 133 : | The type of evidence (required). | ||
| 134 : | |||
| 135 : | Where type is one of the following: | ||
| 136 : | |||
| 137 : | =over 8 | ||
| 138 : | |||
| 139 : | =item seq=Sequence similarity | ||
| 140 : | |||
| 141 : | =item dom=domain based match | ||
| 142 : | |||
| 143 : | =item loc=Localization of the feature | ||
| 144 : | |||
| 145 : | =item fc=Functional coupling. | ||
| 146 : | |||
| 147 : | =back | ||
| 148 : | |||
| 149 : | =cut | ||
| 150 : | |||
| 151 : | sub type { | ||
| 152 : | my ($self) = @_; | ||
| 153 : | |||
| 154 : | arodri7 | 1.26 | return $self->{type}; |
| 155 : | mkubal | 1.1 | } |
| 156 : | |||
| 157 : | =head3 start() | ||
| 158 : | |||
| 159 : | Start of hit in query sequence. | ||
| 160 : | |||
| 161 : | =cut | ||
| 162 : | |||
| 163 : | sub start { | ||
| 164 : | my ($self) = @_; | ||
| 165 : | |||
| 166 : | return $self->{start}; | ||
| 167 : | } | ||
| 168 : | |||
| 169 : | =head3 end() | ||
| 170 : | |||
| 171 : | End of the hit in query sequence. | ||
| 172 : | |||
| 173 : | =cut | ||
| 174 : | |||
| 175 : | sub stop { | ||
| 176 : | my ($self) = @_; | ||
| 177 : | |||
| 178 : | return $self->{stop}; | ||
| 179 : | } | ||
| 180 : | |||
| 181 : | arodri7 | 1.11 | =head3 start() |
| 182 : | |||
| 183 : | Start of hit in query sequence. | ||
| 184 : | |||
| 185 : | =cut | ||
| 186 : | |||
| 187 : | sub qstart { | ||
| 188 : | my ($self) = @_; | ||
| 189 : | |||
| 190 : | return $self->{qstart}; | ||
| 191 : | } | ||
| 192 : | |||
| 193 : | =head3 qstop() | ||
| 194 : | |||
| 195 : | End of the hit in query sequence. | ||
| 196 : | |||
| 197 : | =cut | ||
| 198 : | |||
| 199 : | sub qstop { | ||
| 200 : | my ($self) = @_; | ||
| 201 : | |||
| 202 : | return $self->{qstop}; | ||
| 203 : | } | ||
| 204 : | |||
| 205 : | =head3 hstart() | ||
| 206 : | |||
| 207 : | Start of hit in hit sequence. | ||
| 208 : | |||
| 209 : | =cut | ||
| 210 : | |||
| 211 : | sub hstart { | ||
| 212 : | my ($self) = @_; | ||
| 213 : | |||
| 214 : | return $self->{hstart}; | ||
| 215 : | } | ||
| 216 : | |||
| 217 : | =head3 end() | ||
| 218 : | |||
| 219 : | End of the hit in hit sequence. | ||
| 220 : | |||
| 221 : | =cut | ||
| 222 : | |||
| 223 : | sub hstop { | ||
| 224 : | my ($self) = @_; | ||
| 225 : | |||
| 226 : | return $self->{hstop}; | ||
| 227 : | } | ||
| 228 : | |||
| 229 : | =head3 qlength() | ||
| 230 : | |||
| 231 : | length of the query sequence in similarities | ||
| 232 : | |||
| 233 : | =cut | ||
| 234 : | |||
| 235 : | sub qlength { | ||
| 236 : | my ($self) = @_; | ||
| 237 : | |||
| 238 : | return $self->{qlength}; | ||
| 239 : | } | ||
| 240 : | |||
| 241 : | =head3 hlength() | ||
| 242 : | |||
| 243 : | length of the hit sequence in similarities | ||
| 244 : | |||
| 245 : | =cut | ||
| 246 : | |||
| 247 : | sub hlength { | ||
| 248 : | my ($self) = @_; | ||
| 249 : | |||
| 250 : | return $self->{hlength}; | ||
| 251 : | } | ||
| 252 : | |||
| 253 : | mkubal | 1.1 | =head3 evalue() |
| 254 : | |||
| 255 : | E-value or P-Value if present. | ||
| 256 : | |||
| 257 : | =cut | ||
| 258 : | |||
| 259 : | sub evalue { | ||
| 260 : | my ($self) = @_; | ||
| 261 : | |||
| 262 : | return $self->{evalue}; | ||
| 263 : | } | ||
| 264 : | |||
| 265 : | =head3 score() | ||
| 266 : | |||
| 267 : | Score if present. | ||
| 268 : | |||
| 269 : | =cut | ||
| 270 : | |||
| 271 : | sub score { | ||
| 272 : | my ($self) = @_; | ||
| 273 : | return $self->{score}; | ||
| 274 : | } | ||
| 275 : | |||
| 276 : | mkubal | 1.12 | =head3 display() |
| 277 : | mkubal | 1.1 | |
| 278 : | mkubal | 1.12 | will be different for each type |
| 279 : | mkubal | 1.1 | |
| 280 : | =cut | ||
| 281 : | |||
| 282 : | mkubal | 1.7 | sub display { |
| 283 : | mkubal | 1.1 | |
| 284 : | mkubal | 1.7 | die "Abstract Method Called\n"; |
| 285 : | mkubal | 1.1 | |
| 286 : | } | ||
| 287 : | |||
| 288 : | mkubal | 1.24 | =head3 display_table() |
| 289 : | mkubal | 1.7 | |
| 290 : | mkubal | 1.24 | will be different for each type |
| 291 : | mkubal | 1.1 | |
| 292 : | mkubal | 1.24 | =cut |
| 293 : | mkubal | 1.1 | |
| 294 : | mkubal | 1.24 | sub display_table { |
| 295 : | |||
| 296 : | die "Abstract Table Method Called\n"; | ||
| 297 : | mkubal | 1.1 | |
| 298 : | } | ||
| 299 : | |||
| 300 : | =head3 get_objects() | ||
| 301 : | |||
| 302 : | This is the B<REAL WORKHORSE> method of this Package. | ||
| 303 : | |||
| 304 : | =cut | ||
| 305 : | |||
| 306 : | sub get_objects { | ||
| 307 : | mkubal | 1.24 | my ($self,$fid,$scope) = @_; |
| 308 : | mkubal | 1.7 | |
| 309 : | my $objects = []; | ||
| 310 : | my @matched_datasets=(); | ||
| 311 : | arodri7 | 1.28 | my $fig = new FIG; |
| 312 : | mkubal | 1.1 | |
| 313 : | mkubal | 1.7 | # call function that fetches attribute based observations |
| 314 : | # returns an array of arrays of hashes | ||
| 315 : | |||
| 316 : | mkubal | 1.24 | if($scope){ |
| 317 : | get_cluster_observations($fid,\@matched_datasets,$scope); | ||
| 318 : | mkubal | 1.7 | } |
| 319 : | else{ | ||
| 320 : | my %domain_classes; | ||
| 321 : | arodri7 | 1.28 | my @attributes = $fig->get_attributes($fid); |
| 322 : | mkubal | 1.24 | $domain_classes{'CDD'} = 1; |
| 323 : | get_identical_proteins($fid,\@matched_datasets); | ||
| 324 : | arodri7 | 1.28 | get_attribute_based_domain_observations($fid,\%domain_classes,\@matched_datasets,\@attributes); |
| 325 : | mkubal | 1.24 | get_sims_observations($fid,\@matched_datasets); |
| 326 : | get_functional_coupling($fid,\@matched_datasets); | ||
| 327 : | arodri7 | 1.28 | get_attribute_based_location_observations($fid,\@matched_datasets,\@attributes); |
| 328 : | get_pdb_observations($fid,\@matched_datasets,\@attributes); | ||
| 329 : | mkubal | 1.1 | } |
| 330 : | mkubal | 1.7 | |
| 331 : | foreach my $dataset (@matched_datasets) { | ||
| 332 : | my $object; | ||
| 333 : | if($dataset->{'type'} eq "dom"){ | ||
| 334 : | $object = Observation::Domain->new($dataset); | ||
| 335 : | } | ||
| 336 : | arodri7 | 1.9 | if($dataset->{'class'} eq "PCH"){ |
| 337 : | $object = Observation::FC->new($dataset); | ||
| 338 : | } | ||
| 339 : | if ($dataset->{'class'} eq "IDENTICAL"){ | ||
| 340 : | $object = Observation::Identical->new($dataset); | ||
| 341 : | } | ||
| 342 : | mkubal | 1.12 | if ($dataset->{'class'} eq "SIGNALP_CELLO_TMPRED"){ |
| 343 : | $object = Observation::Location->new($dataset); | ||
| 344 : | } | ||
| 345 : | arodri7 | 1.10 | if ($dataset->{'class'} eq "SIM"){ |
| 346 : | $object = Observation::Sims->new($dataset); | ||
| 347 : | } | ||
| 348 : | arodri7 | 1.15 | if ($dataset->{'class'} eq "CLUSTER"){ |
| 349 : | $object = Observation::Cluster->new($dataset); | ||
| 350 : | } | ||
| 351 : | mkubal | 1.20 | if ($dataset->{'class'} eq "PDB"){ |
| 352 : | $object = Observation::PDB->new($dataset); | ||
| 353 : | } | ||
| 354 : | |||
| 355 : | mkubal | 1.7 | push (@$objects, $object); |
| 356 : | mkubal | 1.1 | } |
| 357 : | mkubal | 1.7 | |
| 358 : | return $objects; | ||
| 359 : | mkubal | 1.1 | |
| 360 : | } | ||
| 361 : | |||
| 362 : | arodri7 | 1.28 | =head3 display_housekeeping |
| 363 : | This method returns the housekeeping data for a given peg in a table format | ||
| 364 : | |||
| 365 : | =cut | ||
| 366 : | sub display_housekeeping { | ||
| 367 : | my ($self,$fid) = @_; | ||
| 368 : | my $fig = new FIG; | ||
| 369 : | my $content; | ||
| 370 : | |||
| 371 : | my $org_name = $fig->org_of($fid); | ||
| 372 : | my $org_id = $fig->orgid_of_orgname($org_name); | ||
| 373 : | my $loc = $fig->feature_location($fid); | ||
| 374 : | my($contig, $beg, $end) = $fig->boundaries_of($loc); | ||
| 375 : | my $strand = ($beg <= $end)? '+' : '-'; | ||
| 376 : | my @subsystems = $fig->subsystems_for_peg($fid); | ||
| 377 : | my $function = $fig->function_of($fid); | ||
| 378 : | my @aliases = $fig->feature_aliases($fid); | ||
| 379 : | my $taxonomy = $fig->taxonomy_of($org_id); | ||
| 380 : | my @ecs = ($function =~ /\(EC\s(\d+\.[-\d+]+\.[-\d+]+\.[-\d+]+)\)/g); | ||
| 381 : | |||
| 382 : | $content .= qq(<b>General Protein Data</b><br><br><br><table border="0">); | ||
| 383 : | $content .= qq(<tr width=15%><td >FIG ID</td><td>$fid</td></tr>\n); | ||
| 384 : | $content .= qq(<tr width=15%><td >Organism Name</td><td>$org_name, $org_id</td></tr>\n); | ||
| 385 : | $content .= qq(<tr><td width=15%>Taxonomy</td><td>$taxonomy</td></tr>\n); | ||
| 386 : | $content .= qq(<tr width=15%><td>FIG Organism ID</td><td>$org_id</td></tr>\n); | ||
| 387 : | $content .= qq(<tr width=15%><td>Gene Location</td><td>Contig $contig [$beg,$end], Strand $strand</td></tr>\n);; | ||
| 388 : | $content .= qq(<tr width=15%><td>Function</td><td>$function</td></tr>\n); | ||
| 389 : | if ( @ecs ) { | ||
| 390 : | $content .= qq(<tr><td>EC:</td><td>); | ||
| 391 : | foreach my $ec ( @ecs ) { | ||
| 392 : | my $ec_name = $fig->ec_name($ec); | ||
| 393 : | $content .= join(" -- ", $ec, $ec_name) . "<br>\n"; | ||
| 394 : | } | ||
| 395 : | $content .= qq(</td></tr>\n); | ||
| 396 : | } | ||
| 397 : | |||
| 398 : | if ( @subsystems ) { | ||
| 399 : | $content .= qq(<tr><td>Subsystems</td><td>); | ||
| 400 : | foreach my $subsystem ( @subsystems ) { | ||
| 401 : | $content .= join(" -- ", @$subsystem) . "<br>\n"; | ||
| 402 : | } | ||
| 403 : | } | ||
| 404 : | |||
| 405 : | my %groups; | ||
| 406 : | if ( @aliases ) { | ||
| 407 : | # get the db for each alias | ||
| 408 : | foreach my $alias (@aliases){ | ||
| 409 : | $groups{$alias} = &get_database($alias); | ||
| 410 : | } | ||
| 411 : | |||
| 412 : | # group ids by aliases | ||
| 413 : | my %db_aliases; | ||
| 414 : | foreach my $key (sort {$groups{$a} cmp $groups{$b}} keys %groups){ | ||
| 415 : | push (@{$db_aliases{$groups{$key}}}, $key); | ||
| 416 : | } | ||
| 417 : | |||
| 418 : | |||
| 419 : | $content .= qq(<tr><td>Aliases</td><td><table border="0">); | ||
| 420 : | foreach my $key (sort keys %db_aliases){ | ||
| 421 : | $content .= qq(<tr><td>$key:</td><td>) . join(", ", @{$db_aliases{$key}}) . qq(</td></tr\n); | ||
| 422 : | } | ||
| 423 : | $content .= qq(</td></tr></table>\n); | ||
| 424 : | } | ||
| 425 : | |||
| 426 : | $content .= qq(</table><p>\n); | ||
| 427 : | |||
| 428 : | return ($content); | ||
| 429 : | } | ||
| 430 : | |||
| 431 : | =head3 get_sims_summary | ||
| 432 : | This method uses as input the similarities of a peg and creates a tree view of their taxonomy | ||
| 433 : | |||
| 434 : | =cut | ||
| 435 : | |||
| 436 : | sub get_sims_summary { | ||
| 437 : | my ($observation, $fid) = @_; | ||
| 438 : | my $fig = new FIG; | ||
| 439 : | my %families; | ||
| 440 : | my @sims= $fig->nsims($fid,20000,10,"all"); | ||
| 441 : | |||
| 442 : | foreach my $sim (@sims){ | ||
| 443 : | next if ($sim->[1] !~ /fig\|/); | ||
| 444 : | my $genome = $fig->genome_of($sim->[1]); | ||
| 445 : | my $taxonomy = $fig->taxonomy_of($fig->genome_of($sim->[1])); | ||
| 446 : | my $parent_tax = "Root"; | ||
| 447 : | foreach my $tax (split(/\; /, $taxonomy)){ | ||
| 448 : | push (@{$families{children}{$parent_tax}}, $tax); | ||
| 449 : | $families{parent}{$tax} = $parent_tax; | ||
| 450 : | $parent_tax = $tax; | ||
| 451 : | } | ||
| 452 : | } | ||
| 453 : | |||
| 454 : | foreach my $key (keys %{$families{children}}){ | ||
| 455 : | $families{count}{$key} = @{$families{children}{$key}}; | ||
| 456 : | |||
| 457 : | my %saw; | ||
| 458 : | my @out = grep(!$saw{$_}++, @{$families{children}{$key}}); | ||
| 459 : | $families{children}{$key} = \@out; | ||
| 460 : | } | ||
| 461 : | return (\%families); | ||
| 462 : | } | ||
| 463 : | |||
| 464 : | mkubal | 1.1 | =head1 Internal Methods |
| 465 : | |||
| 466 : | These methods are not meant to be used outside of this package. | ||
| 467 : | |||
| 468 : | B<Please do not use them outside of this package!> | ||
| 469 : | |||
| 470 : | =cut | ||
| 471 : | |||
| 472 : | mkubal | 1.7 | sub get_attribute_based_domain_observations{ |
| 473 : | |||
| 474 : | # we read a FIG ID and a reference to an array (of arrays of hashes, see above) | ||
| 475 : | arodri7 | 1.28 | my ($fid,$domain_classes,$datasets_ref,$attributes_ref) = (@_); |
| 476 : | mkubal | 1.7 | |
| 477 : | my $fig = new FIG; | ||
| 478 : | arodri7 | 1.28 | |
| 479 : | foreach my $attr_ref (@$attributes_ref) { | ||
| 480 : | # foreach my $attr_ref ($fig->get_attributes($fid)) { | ||
| 481 : | mkubal | 1.7 | my $key = @$attr_ref[1]; |
| 482 : | my @parts = split("::",$key); | ||
| 483 : | my $class = $parts[0]; | ||
| 484 : | |||
| 485 : | if($domain_classes->{$parts[0]}){ | ||
| 486 : | my $val = @$attr_ref[2]; | ||
| 487 : | mkubal | 1.8 | if($val =~/^(\d+\.\d+|0\.0);(\d+)-(\d+)/){ |
| 488 : | mkubal | 1.7 | my $raw_evalue = $1; |
| 489 : | mkubal | 1.8 | my $from = $2; |
| 490 : | my $to = $3; | ||
| 491 : | mkubal | 1.7 | my $evalue; |
| 492 : | if($raw_evalue =~/(\d+)\.(\d+)/){ | ||
| 493 : | my $part2 = 1000 - $1; | ||
| 494 : | my $part1 = $2/100; | ||
| 495 : | $evalue = $part1."e-".$part2; | ||
| 496 : | } | ||
| 497 : | else{ | ||
| 498 : | mkubal | 1.8 | $evalue = "0.0"; |
| 499 : | mkubal | 1.7 | } |
| 500 : | |||
| 501 : | my $dataset = {'class' => $class, | ||
| 502 : | 'acc' => $key, | ||
| 503 : | 'type' => "dom" , | ||
| 504 : | 'evalue' => $evalue, | ||
| 505 : | 'start' => $from, | ||
| 506 : | mkubal | 1.24 | 'stop' => $to, |
| 507 : | 'fig_id' => $fid, | ||
| 508 : | 'score' => $raw_evalue | ||
| 509 : | mkubal | 1.7 | }; |
| 510 : | |||
| 511 : | push (@{$datasets_ref} ,$dataset); | ||
| 512 : | } | ||
| 513 : | } | ||
| 514 : | } | ||
| 515 : | } | ||
| 516 : | mkubal | 1.12 | |
| 517 : | sub get_attribute_based_location_observations{ | ||
| 518 : | |||
| 519 : | arodri7 | 1.28 | my ($fid,$datasets_ref, $attributes_ref) = (@_); |
| 520 : | mkubal | 1.12 | my $fig = new FIG; |
| 521 : | |||
| 522 : | my $location_attributes = ['SignalP','CELLO','TMPRED']; | ||
| 523 : | |||
| 524 : | arodri7 | 1.26 | my $dataset = {'type' => "loc", |
| 525 : | 'class' => 'SIGNALP_CELLO_TMPRED', | ||
| 526 : | 'fig_id' => $fid | ||
| 527 : | }; | ||
| 528 : | |||
| 529 : | arodri7 | 1.28 | foreach my $attr_ref (@$attributes_ref){ |
| 530 : | # foreach my $attr_ref ($fig->get_attributes($fid,$location_attributes)) { | ||
| 531 : | mkubal | 1.12 | my $key = @$attr_ref[1]; |
| 532 : | arodri7 | 1.28 | next if (($key !~ /SignalP/) && ($key !~ /CELLO/) && ($key !~ /TMPRED/)); |
| 533 : | mkubal | 1.12 | my @parts = split("::",$key); |
| 534 : | my $sub_class = $parts[0]; | ||
| 535 : | my $sub_key = $parts[1]; | ||
| 536 : | my $value = @$attr_ref[2]; | ||
| 537 : | if($sub_class eq "SignalP"){ | ||
| 538 : | if($sub_key eq "cleavage_site"){ | ||
| 539 : | my @value_parts = split(";",$value); | ||
| 540 : | $dataset->{'cleavage_prob'} = $value_parts[0]; | ||
| 541 : | $dataset->{'cleavage_loc'} = $value_parts[1]; | ||
| 542 : | arodri7 | 1.28 | # print STDERR "LOC: $value_parts[1]"; |
| 543 : | mkubal | 1.12 | } |
| 544 : | elsif($sub_key eq "signal_peptide"){ | ||
| 545 : | $dataset->{'signal_peptide_score'} = $value; | ||
| 546 : | } | ||
| 547 : | } | ||
| 548 : | elsif($sub_class eq "CELLO"){ | ||
| 549 : | $dataset->{'cello_location'} = $sub_key; | ||
| 550 : | $dataset->{'cello_score'} = $value; | ||
| 551 : | } | ||
| 552 : | elsif($sub_class eq "TMPRED"){ | ||
| 553 : | arodri7 | 1.26 | my @value_parts = split(/\;/,$value); |
| 554 : | mkubal | 1.12 | $dataset->{'tmpred_score'} = $value_parts[0]; |
| 555 : | $dataset->{'tmpred_locations'} = $value_parts[1]; | ||
| 556 : | } | ||
| 557 : | } | ||
| 558 : | |||
| 559 : | push (@{$datasets_ref} ,$dataset); | ||
| 560 : | |||
| 561 : | } | ||
| 562 : | |||
| 563 : | mkubal | 1.20 | =head3 get_pdb_observations() (internal) |
| 564 : | |||
| 565 : | This methods sets the type and class for pdb observations | ||
| 566 : | |||
| 567 : | =cut | ||
| 568 : | |||
| 569 : | sub get_pdb_observations{ | ||
| 570 : | arodri7 | 1.28 | my ($fid,$datasets_ref, $attributes_ref) = (@_); |
| 571 : | mkubal | 1.20 | |
| 572 : | my $fig = new FIG; | ||
| 573 : | |||
| 574 : | arodri7 | 1.28 | foreach my $attr_ref (@$attributes_ref){ |
| 575 : | #foreach my $attr_ref ($fig->get_attributes($fid,'PDB')) { | ||
| 576 : | mkubal | 1.20 | |
| 577 : | my $key = @$attr_ref[1]; | ||
| 578 : | arodri7 | 1.28 | next if ( ($key !~ /PDB/)); |
| 579 : | mkubal | 1.20 | my($key1,$key2) =split("::",$key); |
| 580 : | my $value = @$attr_ref[2]; | ||
| 581 : | my ($evalue,$location) = split(";",$value); | ||
| 582 : | |||
| 583 : | if($evalue =~/(\d+)\.(\d+)/){ | ||
| 584 : | my $part2 = 1000 - $1; | ||
| 585 : | my $part1 = $2/100; | ||
| 586 : | $evalue = $part1."e-".$part2; | ||
| 587 : | } | ||
| 588 : | |||
| 589 : | my($start,$stop) =split("-",$location); | ||
| 590 : | |||
| 591 : | my $url = @$attr_ref[3]; | ||
| 592 : | my $dataset = {'class' => 'PDB', | ||
| 593 : | 'type' => 'seq' , | ||
| 594 : | 'acc' => $key2, | ||
| 595 : | 'evalue' => $evalue, | ||
| 596 : | 'start' => $start, | ||
| 597 : | mkubal | 1.24 | 'stop' => $stop, |
| 598 : | 'fig_id' => $fid | ||
| 599 : | mkubal | 1.20 | }; |
| 600 : | |||
| 601 : | push (@{$datasets_ref} ,$dataset); | ||
| 602 : | } | ||
| 603 : | } | ||
| 604 : | |||
| 605 : | arodri7 | 1.15 | =head3 get_cluster_observations() (internal) |
| 606 : | |||
| 607 : | This methods sets the type and class for cluster observations | ||
| 608 : | |||
| 609 : | =cut | ||
| 610 : | |||
| 611 : | sub get_cluster_observations{ | ||
| 612 : | mkubal | 1.24 | my ($fid,$datasets_ref,$scope) = (@_); |
| 613 : | arodri7 | 1.15 | |
| 614 : | arodri7 | 1.16 | my $dataset = {'class' => 'CLUSTER', |
| 615 : | mkubal | 1.24 | 'type' => 'fc', |
| 616 : | 'context' => $scope, | ||
| 617 : | 'fig_id' => $fid | ||
| 618 : | arodri7 | 1.16 | }; |
| 619 : | arodri7 | 1.15 | push (@{$datasets_ref} ,$dataset); |
| 620 : | } | ||
| 621 : | |||
| 622 : | |||
| 623 : | mkubal | 1.3 | =head3 get_sims_observations() (internal) |
| 624 : | |||
| 625 : | This methods retrieves sims fills the internal data structures. | ||
| 626 : | |||
| 627 : | =cut | ||
| 628 : | |||
| 629 : | sub get_sims_observations{ | ||
| 630 : | |||
| 631 : | my ($fid,$datasets_ref) = (@_); | ||
| 632 : | mkubal | 1.4 | my $fig = new FIG; |
| 633 : | arodri7 | 1.26 | my @sims= $fig->nsims($fid,500,1e-20,"all"); |
| 634 : | mkubal | 1.4 | my ($dataset); |
| 635 : | arodri7 | 1.26 | |
| 636 : | my %id_list; | ||
| 637 : | mkubal | 1.3 | foreach my $sim (@sims){ |
| 638 : | mkubal | 1.4 | my $hit = $sim->[1]; |
| 639 : | arodri7 | 1.26 | |
| 640 : | next if ($hit !~ /^fig\|/); | ||
| 641 : | my @aliases = $fig->feature_aliases($hit); | ||
| 642 : | foreach my $alias (@aliases){ | ||
| 643 : | $id_list{$alias} = 1; | ||
| 644 : | } | ||
| 645 : | } | ||
| 646 : | |||
| 647 : | my %already; | ||
| 648 : | my (@new_sims, @uniprot); | ||
| 649 : | foreach my $sim (@sims){ | ||
| 650 : | my $hit = $sim->[1]; | ||
| 651 : | my ($id) = ($hit) =~ /\|(.*)/; | ||
| 652 : | next if (defined($already{$id})); | ||
| 653 : | next if (defined($id_list{$hit})); | ||
| 654 : | push (@new_sims, $sim); | ||
| 655 : | $already{$id} = 1; | ||
| 656 : | } | ||
| 657 : | |||
| 658 : | foreach my $sim (@new_sims){ | ||
| 659 : | my $hit = $sim->[1]; | ||
| 660 : | arodri7 | 1.11 | my $percent = $sim->[2]; |
| 661 : | mkubal | 1.4 | my $evalue = $sim->[10]; |
| 662 : | arodri7 | 1.11 | my $qfrom = $sim->[6]; |
| 663 : | my $qto = $sim->[7]; | ||
| 664 : | my $hfrom = $sim->[8]; | ||
| 665 : | my $hto = $sim->[9]; | ||
| 666 : | my $qlength = $sim->[12]; | ||
| 667 : | my $hlength = $sim->[13]; | ||
| 668 : | my $db = get_database($hit); | ||
| 669 : | my $func = $fig->function_of($hit); | ||
| 670 : | my $organism = $fig->org_of($hit); | ||
| 671 : | |||
| 672 : | arodri7 | 1.10 | $dataset = {'class' => 'SIM', |
| 673 : | 'acc' => $hit, | ||
| 674 : | arodri7 | 1.11 | 'identity' => $percent, |
| 675 : | arodri7 | 1.10 | 'type' => 'seq', |
| 676 : | 'evalue' => $evalue, | ||
| 677 : | arodri7 | 1.11 | 'qstart' => $qfrom, |
| 678 : | 'qstop' => $qto, | ||
| 679 : | 'hstart' => $hfrom, | ||
| 680 : | 'hstop' => $hto, | ||
| 681 : | 'database' => $db, | ||
| 682 : | 'organism' => $organism, | ||
| 683 : | 'function' => $func, | ||
| 684 : | 'qlength' => $qlength, | ||
| 685 : | mkubal | 1.24 | 'hlength' => $hlength, |
| 686 : | 'fig_id' => $fid | ||
| 687 : | arodri7 | 1.10 | }; |
| 688 : | |||
| 689 : | push (@{$datasets_ref} ,$dataset); | ||
| 690 : | mkubal | 1.3 | } |
| 691 : | } | ||
| 692 : | |||
| 693 : | arodri7 | 1.11 | =head3 get_database (internal) |
| 694 : | This method gets the database association from the sequence id | ||
| 695 : | |||
| 696 : | =cut | ||
| 697 : | |||
| 698 : | sub get_database{ | ||
| 699 : | my ($id) = (@_); | ||
| 700 : | |||
| 701 : | my ($db); | ||
| 702 : | if ($id =~ /^fig\|/) { $db = "FIG" } | ||
| 703 : | elsif ($id =~ /^gi\|/) { $db = "NCBI" } | ||
| 704 : | elsif ($id =~ /^^[NXYZA]P_/) { $db = "RefSeq" } | ||
| 705 : | elsif ($id =~ /^sp\|/) { $db = "SwissProt" } | ||
| 706 : | elsif ($id =~ /^uni\|/) { $db = "UniProt" } | ||
| 707 : | elsif ($id =~ /^tigr\|/) { $db = "TIGR" } | ||
| 708 : | elsif ($id =~ /^pir\|/) { $db = "PIR" } | ||
| 709 : | arodri7 | 1.28 | elsif (($id =~ /^kegg\|/) || ($id =~ /Spy/)) { $db = "KEGG" } |
| 710 : | elsif ($id =~ /^tr\|/) { $db = "TrEMBL" } | ||
| 711 : | arodri7 | 1.11 | elsif ($id =~ /^eric\|/) { $db = "ASAP" } |
| 712 : | elsif ($id =~ /^img\|/) { $db = "JGI" } | ||
| 713 : | |||
| 714 : | return ($db); | ||
| 715 : | |||
| 716 : | } | ||
| 717 : | |||
| 718 : | mkubal | 1.24 | |
| 719 : | arodri7 | 1.5 | =head3 get_identical_proteins() (internal) |
| 720 : | |||
| 721 : | This methods retrieves sims fills the internal data structures. | ||
| 722 : | |||
| 723 : | =cut | ||
| 724 : | |||
| 725 : | sub get_identical_proteins{ | ||
| 726 : | |||
| 727 : | my ($fid,$datasets_ref) = (@_); | ||
| 728 : | my $fig = new FIG; | ||
| 729 : | mkubal | 1.24 | my $funcs_ref; |
| 730 : | arodri7 | 1.5 | |
| 731 : | arodri7 | 1.26 | my %id_list; |
| 732 : | arodri7 | 1.5 | my @maps_to = grep { $_ ne $fid and $_ !~ /^xxx/ } map { $_->[0] } $fig->mapped_prot_ids($fid); |
| 733 : | arodri7 | 1.26 | my @aliases = $fig->feature_aliases($fid); |
| 734 : | foreach my $alias (@aliases){ | ||
| 735 : | $id_list{$alias} = 1; | ||
| 736 : | } | ||
| 737 : | |||
| 738 : | arodri7 | 1.5 | foreach my $id (@maps_to) { |
| 739 : | my ($tmp, $who); | ||
| 740 : | arodri7 | 1.26 | if (($id ne $fid) && ($tmp = $fig->function_of($id)) && (! defined ($id_list{$id}))) { |
| 741 : | arodri7 | 1.11 | $who = &get_database($id); |
| 742 : | mkubal | 1.24 | push(@$funcs_ref, [$id,$who,$tmp]); |
| 743 : | arodri7 | 1.5 | } |
| 744 : | } | ||
| 745 : | |||
| 746 : | my ($dataset); | ||
| 747 : | mkubal | 1.24 | my $dataset = {'class' => 'IDENTICAL', |
| 748 : | 'type' => 'seq', | ||
| 749 : | 'fig_id' => $fid, | ||
| 750 : | 'rows' => $funcs_ref | ||
| 751 : | }; | ||
| 752 : | |||
| 753 : | push (@{$datasets_ref} ,$dataset); | ||
| 754 : | |||
| 755 : | arodri7 | 1.5 | |
| 756 : | } | ||
| 757 : | |||
| 758 : | arodri7 | 1.6 | =head3 get_functional_coupling() (internal) |
| 759 : | |||
| 760 : | This methods retrieves the functional coupling of a protein given a peg ID | ||
| 761 : | |||
| 762 : | =cut | ||
| 763 : | |||
| 764 : | sub get_functional_coupling{ | ||
| 765 : | |||
| 766 : | my ($fid,$datasets_ref) = (@_); | ||
| 767 : | my $fig = new FIG; | ||
| 768 : | my @funcs = (); | ||
| 769 : | |||
| 770 : | # initialize some variables | ||
| 771 : | my($sc,$neigh); | ||
| 772 : | |||
| 773 : | # set default parameters for coupling and evidence | ||
| 774 : | my ($bound,$sim_cutoff,$coupling_cutoff) = (5000, 1.0e-10, 4); | ||
| 775 : | |||
| 776 : | # get the fc data | ||
| 777 : | my @fc_data = $fig->coupling_and_evidence($fid,$bound,$sim_cutoff,$coupling_cutoff,1); | ||
| 778 : | |||
| 779 : | # retrieve data | ||
| 780 : | my @rows = map { ($sc,$neigh) = @$_; | ||
| 781 : | [$sc,$neigh,scalar $fig->function_of($neigh)] | ||
| 782 : | } @fc_data; | ||
| 783 : | |||
| 784 : | my ($dataset); | ||
| 785 : | mkubal | 1.24 | my $dataset = {'class' => 'PCH', |
| 786 : | 'type' => 'fc', | ||
| 787 : | 'fig_id' => $fid, | ||
| 788 : | 'rows' => \@rows | ||
| 789 : | }; | ||
| 790 : | |||
| 791 : | push (@{$datasets_ref} ,$dataset); | ||
| 792 : | arodri7 | 1.9 | |
| 793 : | arodri7 | 1.6 | } |
| 794 : | arodri7 | 1.5 | |
| 795 : | mkubal | 1.1 | =head3 new (internal) |
| 796 : | |||
| 797 : | Instantiate a new object. | ||
| 798 : | |||
| 799 : | =cut | ||
| 800 : | |||
| 801 : | sub new { | ||
| 802 : | mkubal | 1.7 | my ($class,$dataset) = @_; |
| 803 : | |||
| 804 : | my $self = { class => $dataset->{'class'}, | ||
| 805 : | mkubal | 1.24 | type => $dataset->{'type'}, |
| 806 : | fig_id => $dataset->{'fig_id'}, | ||
| 807 : | score => $dataset->{'score'}, | ||
| 808 : | arodri7 | 1.10 | }; |
| 809 : | mkubal | 1.7 | |
| 810 : | bless($self,$class); | ||
| 811 : | mkubal | 1.1 | |
| 812 : | return $self; | ||
| 813 : | } | ||
| 814 : | |||
| 815 : | arodri7 | 1.11 | =head3 identity (internal) |
| 816 : | |||
| 817 : | Returns the % identity of the similar sequence | ||
| 818 : | |||
| 819 : | =cut | ||
| 820 : | |||
| 821 : | sub identity { | ||
| 822 : | my ($self) = @_; | ||
| 823 : | |||
| 824 : | return $self->{identity}; | ||
| 825 : | } | ||
| 826 : | |||
| 827 : | mkubal | 1.24 | =head3 fig_id (internal) |
| 828 : | |||
| 829 : | =cut | ||
| 830 : | |||
| 831 : | sub fig_id { | ||
| 832 : | my ($self) = @_; | ||
| 833 : | return $self->{fig_id}; | ||
| 834 : | } | ||
| 835 : | |||
| 836 : | mkubal | 1.1 | =head3 feature_id (internal) |
| 837 : | |||
| 838 : | |||
| 839 : | =cut | ||
| 840 : | |||
| 841 : | sub feature_id { | ||
| 842 : | my ($self) = @_; | ||
| 843 : | |||
| 844 : | return $self->{feature_id}; | ||
| 845 : | } | ||
| 846 : | arodri7 | 1.5 | |
| 847 : | =head3 id (internal) | ||
| 848 : | |||
| 849 : | Returns the ID of the identical sequence | ||
| 850 : | |||
| 851 : | =cut | ||
| 852 : | |||
| 853 : | sub id { | ||
| 854 : | my ($self) = @_; | ||
| 855 : | |||
| 856 : | return $self->{id}; | ||
| 857 : | } | ||
| 858 : | |||
| 859 : | =head3 organism (internal) | ||
| 860 : | |||
| 861 : | Returns the organism of the identical sequence | ||
| 862 : | |||
| 863 : | =cut | ||
| 864 : | |||
| 865 : | sub organism { | ||
| 866 : | my ($self) = @_; | ||
| 867 : | |||
| 868 : | return $self->{organism}; | ||
| 869 : | } | ||
| 870 : | |||
| 871 : | arodri7 | 1.9 | =head3 function (internal) |
| 872 : | |||
| 873 : | Returns the function of the identical sequence | ||
| 874 : | |||
| 875 : | =cut | ||
| 876 : | |||
| 877 : | sub function { | ||
| 878 : | my ($self) = @_; | ||
| 879 : | |||
| 880 : | return $self->{function}; | ||
| 881 : | } | ||
| 882 : | |||
| 883 : | arodri7 | 1.5 | =head3 database (internal) |
| 884 : | |||
| 885 : | Returns the database of the identical sequence | ||
| 886 : | |||
| 887 : | =cut | ||
| 888 : | |||
| 889 : | sub database { | ||
| 890 : | my ($self) = @_; | ||
| 891 : | |||
| 892 : | return $self->{database}; | ||
| 893 : | } | ||
| 894 : | |||
| 895 : | mkubal | 1.24 | sub score { |
| 896 : | my ($self) = @_; | ||
| 897 : | |||
| 898 : | return $self->{score}; | ||
| 899 : | } | ||
| 900 : | |||
| 901 : | mkubal | 1.20 | ############################################################ |
| 902 : | ############################################################ | ||
| 903 : | package Observation::PDB; | ||
| 904 : | |||
| 905 : | use base qw(Observation); | ||
| 906 : | |||
| 907 : | sub new { | ||
| 908 : | |||
| 909 : | my ($class,$dataset) = @_; | ||
| 910 : | my $self = $class->SUPER::new($dataset); | ||
| 911 : | $self->{acc} = $dataset->{'acc'}; | ||
| 912 : | $self->{evalue} = $dataset->{'evalue'}; | ||
| 913 : | $self->{start} = $dataset->{'start'}; | ||
| 914 : | $self->{stop} = $dataset->{'stop'}; | ||
| 915 : | bless($self,$class); | ||
| 916 : | return $self; | ||
| 917 : | } | ||
| 918 : | |||
| 919 : | =head3 display() | ||
| 920 : | |||
| 921 : | displays data stored in best_PDB attribute and in Ontology server for given PDB id | ||
| 922 : | |||
| 923 : | =cut | ||
| 924 : | |||
| 925 : | sub display{ | ||
| 926 : | mkubal | 1.24 | my ($self,$gd) = @_; |
| 927 : | mkubal | 1.20 | |
| 928 : | mkubal | 1.24 | my $fid = $self->fig_id; |
| 929 : | mkubal | 1.20 | my $dbmaster = DBMaster->new(-database =>'Ontology'); |
| 930 : | |||
| 931 : | my $acc = $self->acc; | ||
| 932 : | |||
| 933 : | my ($pdb_description,$pdb_source,$pdb_ligand); | ||
| 934 : | my $pdb_objs = $dbmaster->pdb->get_objects( { 'id' => $acc } ); | ||
| 935 : | if(!scalar(@$pdb_objs)){ | ||
| 936 : | $pdb_description = "not available"; | ||
| 937 : | $pdb_source = "not available"; | ||
| 938 : | $pdb_ligand = "not available"; | ||
| 939 : | } | ||
| 940 : | else{ | ||
| 941 : | my $pdb_obj = $pdb_objs->[0]; | ||
| 942 : | $pdb_description = $pdb_obj->description; | ||
| 943 : | $pdb_source = $pdb_obj->source; | ||
| 944 : | $pdb_ligand = $pdb_obj->ligand; | ||
| 945 : | } | ||
| 946 : | arodri7 | 1.6 | |
| 947 : | mkubal | 1.20 | my $lines = []; |
| 948 : | my $line_data = []; | ||
| 949 : | my $line_config = { 'title' => "PDB hit for $fid", | ||
| 950 : | 'short_title' => "best PDB", | ||
| 951 : | 'basepair_offset' => '1' }; | ||
| 952 : | |||
| 953 : | my $fig = new FIG; | ||
| 954 : | my $seq = $fig->get_translation($fid); | ||
| 955 : | my $fid_stop = length($seq); | ||
| 956 : | |||
| 957 : | my $fid_element_hash = { | ||
| 958 : | "title" => $fid, | ||
| 959 : | "start" => '1', | ||
| 960 : | "end" => $fid_stop, | ||
| 961 : | "color"=> '1', | ||
| 962 : | "zlayer" => '1' | ||
| 963 : | }; | ||
| 964 : | |||
| 965 : | push(@$line_data,$fid_element_hash); | ||
| 966 : | |||
| 967 : | my $links_list = []; | ||
| 968 : | my $descriptions = []; | ||
| 969 : | |||
| 970 : | my $name; | ||
| 971 : | $name = {"title" => 'id', | ||
| 972 : | "value" => $acc}; | ||
| 973 : | push(@$descriptions,$name); | ||
| 974 : | |||
| 975 : | my $description; | ||
| 976 : | $description = {"title" => 'pdb description', | ||
| 977 : | "value" => $pdb_description}; | ||
| 978 : | push(@$descriptions,$description); | ||
| 979 : | |||
| 980 : | my $score; | ||
| 981 : | $score = {"title" => "score", | ||
| 982 : | "value" => $self->evalue}; | ||
| 983 : | push(@$descriptions,$score); | ||
| 984 : | |||
| 985 : | my $start_stop; | ||
| 986 : | my $start_stop_value = $self->start."_".$self->stop; | ||
| 987 : | $start_stop = {"title" => "start-stop", | ||
| 988 : | "value" => $start_stop_value}; | ||
| 989 : | push(@$descriptions,$start_stop); | ||
| 990 : | |||
| 991 : | my $source; | ||
| 992 : | $source = {"title" => "source", | ||
| 993 : | "value" => $pdb_source}; | ||
| 994 : | push(@$descriptions,$source); | ||
| 995 : | |||
| 996 : | my $ligand; | ||
| 997 : | $ligand = {"title" => "pdb ligand", | ||
| 998 : | "value" => $pdb_ligand}; | ||
| 999 : | push(@$descriptions,$ligand); | ||
| 1000 : | |||
| 1001 : | my $link; | ||
| 1002 : | my $link_url ="http://www.rcsb.org/pdb/explore/explore.do?structureId=".$acc; | ||
| 1003 : | |||
| 1004 : | $link = {"link_title" => $acc, | ||
| 1005 : | "link" => $link_url}; | ||
| 1006 : | push(@$links_list,$link); | ||
| 1007 : | |||
| 1008 : | my $pdb_element_hash = { | ||
| 1009 : | "title" => "PDB homology", | ||
| 1010 : | "start" => $self->start, | ||
| 1011 : | "end" => $self->stop, | ||
| 1012 : | "color"=> '6', | ||
| 1013 : | "zlayer" => '3', | ||
| 1014 : | "links_list" => $links_list, | ||
| 1015 : | "description" => $descriptions}; | ||
| 1016 : | |||
| 1017 : | push(@$line_data,$pdb_element_hash); | ||
| 1018 : | $gd->add_line($line_data, $line_config); | ||
| 1019 : | |||
| 1020 : | return $gd; | ||
| 1021 : | } | ||
| 1022 : | |||
| 1023 : | 1; | ||
| 1024 : | arodri7 | 1.11 | |
| 1025 : | arodri7 | 1.9 | ############################################################ |
| 1026 : | ############################################################ | ||
| 1027 : | package Observation::Identical; | ||
| 1028 : | |||
| 1029 : | use base qw(Observation); | ||
| 1030 : | |||
| 1031 : | sub new { | ||
| 1032 : | |||
| 1033 : | my ($class,$dataset) = @_; | ||
| 1034 : | my $self = $class->SUPER::new($dataset); | ||
| 1035 : | mkubal | 1.24 | $self->{rows} = $dataset->{'rows'}; |
| 1036 : | |||
| 1037 : | arodri7 | 1.9 | bless($self,$class); |
| 1038 : | return $self; | ||
| 1039 : | } | ||
| 1040 : | |||
| 1041 : | mkubal | 1.24 | =head3 display_table() |
| 1042 : | arodri7 | 1.6 | |
| 1043 : | If available use the function specified here to display the "raw" observation. | ||
| 1044 : | This code will display a table for the identical protein | ||
| 1045 : | |||
| 1046 : | |||
| 1047 : | arodri7 | 1.9 | B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evi |
| 1048 : | dence. | ||
| 1049 : | arodri7 | 1.6 | |
| 1050 : | =cut | ||
| 1051 : | |||
| 1052 : | |||
| 1053 : | mkubal | 1.24 | sub display_table{ |
| 1054 : | my ($self) = @_; | ||
| 1055 : | |||
| 1056 : | my $fig = new FIG; | ||
| 1057 : | my $fid = $self->fig_id; | ||
| 1058 : | my $rows = $self->rows; | ||
| 1059 : | my $cgi = new CGI; | ||
| 1060 : | arodri7 | 1.6 | my $all_domains = []; |
| 1061 : | my $count_identical = 0; | ||
| 1062 : | arodri7 | 1.9 | my $content; |
| 1063 : | mkubal | 1.24 | foreach my $row (@$rows) { |
| 1064 : | my $id = $row->[0]; | ||
| 1065 : | my $who = $row->[1]; | ||
| 1066 : | my $assignment = $row->[2]; | ||
| 1067 : | arodri7 | 1.26 | my $organism = $fig->org_of($id); |
| 1068 : | arodri7 | 1.9 | my $single_domain = []; |
| 1069 : | mkubal | 1.24 | push(@$single_domain,$who); |
| 1070 : | push(@$single_domain,&HTML::set_prot_links($cgi,$id)); | ||
| 1071 : | push(@$single_domain,$organism); | ||
| 1072 : | push(@$single_domain,$assignment); | ||
| 1073 : | arodri7 | 1.9 | push(@$all_domains,$single_domain); |
| 1074 : | mkubal | 1.24 | $count_identical++; |
| 1075 : | arodri7 | 1.6 | } |
| 1076 : | |||
| 1077 : | if ($count_identical >0){ | ||
| 1078 : | arodri7 | 1.9 | $content = $all_domains; |
| 1079 : | arodri7 | 1.6 | } |
| 1080 : | else{ | ||
| 1081 : | arodri7 | 1.9 | $content = "<p>This PEG does not have any essentially identical proteins</p>"; |
| 1082 : | arodri7 | 1.6 | } |
| 1083 : | return ($content); | ||
| 1084 : | } | ||
| 1085 : | mkubal | 1.7 | |
| 1086 : | arodri7 | 1.9 | 1; |
| 1087 : | |||
| 1088 : | ######################################### | ||
| 1089 : | ######################################### | ||
| 1090 : | package Observation::FC; | ||
| 1091 : | 1; | ||
| 1092 : | |||
| 1093 : | use base qw(Observation); | ||
| 1094 : | |||
| 1095 : | sub new { | ||
| 1096 : | |||
| 1097 : | my ($class,$dataset) = @_; | ||
| 1098 : | my $self = $class->SUPER::new($dataset); | ||
| 1099 : | mkubal | 1.24 | $self->{rows} = $dataset->{'rows'}; |
| 1100 : | arodri7 | 1.9 | |
| 1101 : | bless($self,$class); | ||
| 1102 : | return $self; | ||
| 1103 : | } | ||
| 1104 : | |||
| 1105 : | mkubal | 1.24 | =head3 display_table() |
| 1106 : | arodri7 | 1.9 | |
| 1107 : | If available use the function specified here to display the "raw" observation. | ||
| 1108 : | This code will display a table for the identical protein | ||
| 1109 : | |||
| 1110 : | |||
| 1111 : | B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evi | ||
| 1112 : | dence. | ||
| 1113 : | |||
| 1114 : | =cut | ||
| 1115 : | |||
| 1116 : | mkubal | 1.24 | sub display_table { |
| 1117 : | arodri7 | 1.9 | |
| 1118 : | mkubal | 1.24 | my ($self,$dataset) = @_; |
| 1119 : | my $fid = $self->fig_id; | ||
| 1120 : | my $rows = $self->rows; | ||
| 1121 : | my $cgi = new CGI; | ||
| 1122 : | arodri7 | 1.9 | my $functional_data = []; |
| 1123 : | my $count = 0; | ||
| 1124 : | my $content; | ||
| 1125 : | |||
| 1126 : | mkubal | 1.24 | foreach my $row (@$rows) { |
| 1127 : | arodri7 | 1.9 | my $single_domain = []; |
| 1128 : | $count++; | ||
| 1129 : | |||
| 1130 : | # construct the score link | ||
| 1131 : | mkubal | 1.24 | my $score = $row->[0]; |
| 1132 : | my $toid = $row->[1]; | ||
| 1133 : | arodri7 | 1.9 | my $link = $cgi->url(-relative => 1) . "?user=master&request=show_coupling_evidence&prot=$fid&to=$toid&SPROUT="; |
| 1134 : | my $sc_link = "<a href=$link>$score</a>"; | ||
| 1135 : | |||
| 1136 : | push(@$single_domain,$sc_link); | ||
| 1137 : | mkubal | 1.24 | push(@$single_domain,$row->[1]); |
| 1138 : | push(@$single_domain,$row->[2]); | ||
| 1139 : | arodri7 | 1.9 | push(@$functional_data,$single_domain); |
| 1140 : | } | ||
| 1141 : | |||
| 1142 : | if ($count >0){ | ||
| 1143 : | $content = $functional_data; | ||
| 1144 : | } | ||
| 1145 : | else | ||
| 1146 : | { | ||
| 1147 : | $content = "<p>This PEG does not have any functional coupling</p>"; | ||
| 1148 : | } | ||
| 1149 : | return ($content); | ||
| 1150 : | } | ||
| 1151 : | |||
| 1152 : | |||
| 1153 : | ######################################### | ||
| 1154 : | ######################################### | ||
| 1155 : | mkubal | 1.7 | package Observation::Domain; |
| 1156 : | |||
| 1157 : | use base qw(Observation); | ||
| 1158 : | |||
| 1159 : | sub new { | ||
| 1160 : | |||
| 1161 : | my ($class,$dataset) = @_; | ||
| 1162 : | my $self = $class->SUPER::new($dataset); | ||
| 1163 : | $self->{evalue} = $dataset->{'evalue'}; | ||
| 1164 : | $self->{acc} = $dataset->{'acc'}; | ||
| 1165 : | $self->{start} = $dataset->{'start'}; | ||
| 1166 : | $self->{stop} = $dataset->{'stop'}; | ||
| 1167 : | |||
| 1168 : | bless($self,$class); | ||
| 1169 : | return $self; | ||
| 1170 : | } | ||
| 1171 : | |||
| 1172 : | sub display { | ||
| 1173 : | my ($thing,$gd) = @_; | ||
| 1174 : | my $lines = []; | ||
| 1175 : | arodri7 | 1.27 | # my $line_config = { 'title' => $thing->acc, |
| 1176 : | # 'short_title' => $thing->type, | ||
| 1177 : | # 'basepair_offset' => '1' }; | ||
| 1178 : | mkubal | 1.7 | my $color = "4"; |
| 1179 : | |||
| 1180 : | my $line_data = []; | ||
| 1181 : | my $links_list = []; | ||
| 1182 : | my $descriptions = []; | ||
| 1183 : | mkubal | 1.19 | |
| 1184 : | my $db_and_id = $thing->acc; | ||
| 1185 : | my ($db,$id) = split("::",$db_and_id); | ||
| 1186 : | |||
| 1187 : | my $dbmaster = DBMaster->new(-database =>'Ontology'); | ||
| 1188 : | mkubal | 1.7 | |
| 1189 : | mkubal | 1.19 | my ($name_title,$name_value,$description_title,$description_value); |
| 1190 : | if($db eq "CDD"){ | ||
| 1191 : | my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } ); | ||
| 1192 : | if(!scalar(@$cdd_objs)){ | ||
| 1193 : | $name_title = "name"; | ||
| 1194 : | $name_value = "not available"; | ||
| 1195 : | $description_title = "description"; | ||
| 1196 : | $description_value = "not available"; | ||
| 1197 : | } | ||
| 1198 : | else{ | ||
| 1199 : | my $cdd_obj = $cdd_objs->[0]; | ||
| 1200 : | $name_title = "name"; | ||
| 1201 : | $name_value = $cdd_obj->term; | ||
| 1202 : | $description_title = "description"; | ||
| 1203 : | $description_value = $cdd_obj->description; | ||
| 1204 : | } | ||
| 1205 : | } | ||
| 1206 : | arodri7 | 1.27 | |
| 1207 : | my $line_config = { 'title' => $thing->acc, | ||
| 1208 : | 'short_title' => $name_value, | ||
| 1209 : | 'basepair_offset' => '1' }; | ||
| 1210 : | mkubal | 1.7 | |
| 1211 : | mkubal | 1.19 | my $name; |
| 1212 : | $name = {"title" => $name_title, | ||
| 1213 : | "value" => $name_value}; | ||
| 1214 : | push(@$descriptions,$name); | ||
| 1215 : | |||
| 1216 : | my $description; | ||
| 1217 : | $description = {"title" => $description_title, | ||
| 1218 : | "value" => $description_value}; | ||
| 1219 : | push(@$descriptions,$description); | ||
| 1220 : | mkubal | 1.7 | |
| 1221 : | my $score; | ||
| 1222 : | $score = {"title" => "score", | ||
| 1223 : | "value" => $thing->evalue}; | ||
| 1224 : | push(@$descriptions,$score); | ||
| 1225 : | |||
| 1226 : | my $link_id; | ||
| 1227 : | mkubal | 1.12 | if ($thing->acc =~/\w+::(\d+)/){ |
| 1228 : | mkubal | 1.7 | $link_id = $1; |
| 1229 : | } | ||
| 1230 : | |||
| 1231 : | my $link; | ||
| 1232 : | mkubal | 1.12 | my $link_url; |
| 1233 : | if ($thing->class eq "CDD"){$link_url = "http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=$link_id"} | ||
| 1234 : | elsif($thing->class eq "PFAM"){$link_url = "http://www.sanger.ac.uk/cgi-bin/Pfam/getacc?$link_id"} | ||
| 1235 : | else{$link_url = "NO_URL"} | ||
| 1236 : | |||
| 1237 : | mkubal | 1.7 | $link = {"link_title" => $thing->acc, |
| 1238 : | mkubal | 1.12 | "link" => $link_url}; |
| 1239 : | mkubal | 1.7 | push(@$links_list,$link); |
| 1240 : | |||
| 1241 : | my $element_hash = { | ||
| 1242 : | "title" => $thing->type, | ||
| 1243 : | "start" => $thing->start, | ||
| 1244 : | "end" => $thing->stop, | ||
| 1245 : | "color"=> $color, | ||
| 1246 : | "zlayer" => '2', | ||
| 1247 : | "links_list" => $links_list, | ||
| 1248 : | "description" => $descriptions}; | ||
| 1249 : | |||
| 1250 : | push(@$line_data,$element_hash); | ||
| 1251 : | $gd->add_line($line_data, $line_config); | ||
| 1252 : | |||
| 1253 : | return $gd; | ||
| 1254 : | |||
| 1255 : | } | ||
| 1256 : | arodri7 | 1.28 | |
| 1257 : | sub display_table { | ||
| 1258 : | my ($self,$dataset) = @_; | ||
| 1259 : | my $cgi = new CGI; | ||
| 1260 : | my $data = []; | ||
| 1261 : | my $count = 0; | ||
| 1262 : | my $content; | ||
| 1263 : | |||
| 1264 : | foreach my $thing (@$dataset) { | ||
| 1265 : | next if ($thing->type !~ /dom/); | ||
| 1266 : | my $single_domain = []; | ||
| 1267 : | $count++; | ||
| 1268 : | |||
| 1269 : | my $db_and_id = $thing->acc; | ||
| 1270 : | my ($db,$id) = split("::",$db_and_id); | ||
| 1271 : | |||
| 1272 : | my $dbmaster = DBMaster->new(-database =>'Ontology'); | ||
| 1273 : | |||
| 1274 : | my ($name_title,$name_value,$description_title,$description_value); | ||
| 1275 : | if($db eq "CDD"){ | ||
| 1276 : | my $cdd_objs = $dbmaster->cdd->get_objects( { 'id' => $id } ); | ||
| 1277 : | if(!scalar(@$cdd_objs)){ | ||
| 1278 : | $name_title = "name"; | ||
| 1279 : | $name_value = "not available"; | ||
| 1280 : | $description_title = "description"; | ||
| 1281 : | $description_value = "not available"; | ||
| 1282 : | } | ||
| 1283 : | else{ | ||
| 1284 : | my $cdd_obj = $cdd_objs->[0]; | ||
| 1285 : | $name_title = "name"; | ||
| 1286 : | $name_value = $cdd_obj->term; | ||
| 1287 : | $description_title = "description"; | ||
| 1288 : | $description_value = $cdd_obj->description; | ||
| 1289 : | } | ||
| 1290 : | } | ||
| 1291 : | |||
| 1292 : | my $location = $thing->start . " - " . $thing->stop; | ||
| 1293 : | |||
| 1294 : | push(@$single_domain,$db); | ||
| 1295 : | push(@$single_domain,$thing->acc); | ||
| 1296 : | push(@$single_domain,$name_value); | ||
| 1297 : | push(@$single_domain,$location); | ||
| 1298 : | push(@$single_domain,$thing->evalue); | ||
| 1299 : | push(@$single_domain,$description_value); | ||
| 1300 : | push(@$data,$single_domain); | ||
| 1301 : | } | ||
| 1302 : | |||
| 1303 : | if ($count >0){ | ||
| 1304 : | $content = $data; | ||
| 1305 : | } | ||
| 1306 : | else | ||
| 1307 : | { | ||
| 1308 : | $content = "<p>This PEG does not have any similarities to domains</p>"; | ||
| 1309 : | } | ||
| 1310 : | } | ||
| 1311 : | |||
| 1312 : | mkubal | 1.7 | |
| 1313 : | arodri7 | 1.10 | ######################################### |
| 1314 : | ######################################### | ||
| 1315 : | mkubal | 1.12 | package Observation::Location; |
| 1316 : | |||
| 1317 : | use base qw(Observation); | ||
| 1318 : | |||
| 1319 : | sub new { | ||
| 1320 : | |||
| 1321 : | my ($class,$dataset) = @_; | ||
| 1322 : | my $self = $class->SUPER::new($dataset); | ||
| 1323 : | $self->{cleavage_prob} = $dataset->{'cleavage_prob'}; | ||
| 1324 : | $self->{cleavage_loc} = $dataset->{'cleavage_loc'}; | ||
| 1325 : | $self->{signal_peptide_score} = $dataset->{'signal_peptide_score'}; | ||
| 1326 : | $self->{cello_location} = $dataset->{'cello_location'}; | ||
| 1327 : | $self->{cello_score} = $dataset->{'cello_score'}; | ||
| 1328 : | $self->{tmpred_score} = $dataset->{'tmpred_score'}; | ||
| 1329 : | $self->{tmpred_locations} = $dataset->{'tmpred_locations'}; | ||
| 1330 : | |||
| 1331 : | bless($self,$class); | ||
| 1332 : | return $self; | ||
| 1333 : | } | ||
| 1334 : | |||
| 1335 : | sub display { | ||
| 1336 : | mkubal | 1.24 | my ($thing,$gd) = @_; |
| 1337 : | mkubal | 1.12 | |
| 1338 : | mkubal | 1.24 | my $fid = $thing->fig_id; |
| 1339 : | mkubal | 1.12 | my $fig= new FIG; |
| 1340 : | my $length = length($fig->get_translation($fid)); | ||
| 1341 : | |||
| 1342 : | my $cleavage_prob; | ||
| 1343 : | if($thing->cleavage_prob){$cleavage_prob = $thing->cleavage_prob;} | ||
| 1344 : | my ($cleavage_loc_begin,$cleavage_loc_end) = split("-",$thing->cleavage_loc); | ||
| 1345 : | my $signal_peptide_score = $thing->signal_peptide_score; | ||
| 1346 : | my $cello_location = $thing->cello_location; | ||
| 1347 : | my $cello_score = $thing->cello_score; | ||
| 1348 : | my $tmpred_score = $thing->tmpred_score; | ||
| 1349 : | my @tmpred_locations = split(",",$thing->tmpred_locations); | ||
| 1350 : | |||
| 1351 : | my $lines = []; | ||
| 1352 : | |||
| 1353 : | #color is | ||
| 1354 : | arodri7 | 1.28 | my $color = "6"; |
| 1355 : | mkubal | 1.12 | |
| 1356 : | if($cello_location){ | ||
| 1357 : | my $cello_descriptions = []; | ||
| 1358 : | arodri7 | 1.28 | my $line_data =[]; |
| 1359 : | |||
| 1360 : | my $line_config = { 'title' => 'Localization Evidence', | ||
| 1361 : | 'short_title' => 'CELLO', | ||
| 1362 : | 'basepair_offset' => '1' }; | ||
| 1363 : | |||
| 1364 : | mkubal | 1.12 | my $description_cello_location = {"title" => 'Best Cello Location', |
| 1365 : | "value" => $cello_location}; | ||
| 1366 : | |||
| 1367 : | push(@$cello_descriptions,$description_cello_location); | ||
| 1368 : | |||
| 1369 : | my $description_cello_score = {"title" => 'Cello Score', | ||
| 1370 : | "value" => $cello_score}; | ||
| 1371 : | |||
| 1372 : | push(@$cello_descriptions,$description_cello_score); | ||
| 1373 : | |||
| 1374 : | my $element_hash = { | ||
| 1375 : | "title" => "CELLO", | ||
| 1376 : | "start" => "1", | ||
| 1377 : | "end" => $length + 1, | ||
| 1378 : | "color"=> $color, | ||
| 1379 : | "type" => 'box', | ||
| 1380 : | arodri7 | 1.28 | "zlayer" => '1', |
| 1381 : | mkubal | 1.12 | "description" => $cello_descriptions}; |
| 1382 : | |||
| 1383 : | push(@$line_data,$element_hash); | ||
| 1384 : | arodri7 | 1.28 | $gd->add_line($line_data, $line_config); |
| 1385 : | mkubal | 1.12 | } |
| 1386 : | |||
| 1387 : | arodri7 | 1.28 | |
| 1388 : | $color = "2"; | ||
| 1389 : | mkubal | 1.12 | if($tmpred_score){ |
| 1390 : | arodri7 | 1.28 | my $line_data =[]; |
| 1391 : | my $line_config = { 'title' => 'Localization Evidence', | ||
| 1392 : | 'short_title' => 'Transmembrane', | ||
| 1393 : | 'basepair_offset' => '1' }; | ||
| 1394 : | |||
| 1395 : | |||
| 1396 : | mkubal | 1.12 | foreach my $tmpred (@tmpred_locations){ |
| 1397 : | my $descriptions = []; | ||
| 1398 : | my ($begin,$end) =split("-",$tmpred); | ||
| 1399 : | my $description_tmpred_score = {"title" => 'TMPRED score', | ||
| 1400 : | "value" => $tmpred_score}; | ||
| 1401 : | |||
| 1402 : | push(@$descriptions,$description_tmpred_score); | ||
| 1403 : | |||
| 1404 : | my $element_hash = { | ||
| 1405 : | "title" => "transmembrane location", | ||
| 1406 : | "start" => $begin + 1, | ||
| 1407 : | "end" => $end + 1, | ||
| 1408 : | "color"=> $color, | ||
| 1409 : | "zlayer" => '5', | ||
| 1410 : | "type" => 'smallbox', | ||
| 1411 : | "description" => $descriptions}; | ||
| 1412 : | |||
| 1413 : | push(@$line_data,$element_hash); | ||
| 1414 : | arodri7 | 1.28 | |
| 1415 : | mkubal | 1.12 | } |
| 1416 : | arodri7 | 1.28 | $gd->add_line($line_data, $line_config); |
| 1417 : | mkubal | 1.12 | } |
| 1418 : | |||
| 1419 : | arodri7 | 1.28 | $color = "1"; |
| 1420 : | mkubal | 1.12 | if($signal_peptide_score){ |
| 1421 : | arodri7 | 1.28 | my $line_data = []; |
| 1422 : | mkubal | 1.12 | my $descriptions = []; |
| 1423 : | arodri7 | 1.28 | |
| 1424 : | my $line_config = { 'title' => 'Localization Evidence', | ||
| 1425 : | 'short_title' => 'SignalP', | ||
| 1426 : | 'basepair_offset' => '1' }; | ||
| 1427 : | |||
| 1428 : | mkubal | 1.12 | my $description_signal_peptide_score = {"title" => 'signal peptide score', |
| 1429 : | "value" => $signal_peptide_score}; | ||
| 1430 : | |||
| 1431 : | push(@$descriptions,$description_signal_peptide_score); | ||
| 1432 : | |||
| 1433 : | my $description_cleavage_prob = {"title" => 'cleavage site probability', | ||
| 1434 : | "value" => $cleavage_prob}; | ||
| 1435 : | |||
| 1436 : | push(@$descriptions,$description_cleavage_prob); | ||
| 1437 : | |||
| 1438 : | my $element_hash = { | ||
| 1439 : | "title" => "SignalP", | ||
| 1440 : | "start" => $cleavage_loc_begin - 2, | ||
| 1441 : | arodri7 | 1.28 | "end" => $cleavage_loc_end + 1, |
| 1442 : | mkubal | 1.12 | "type" => 'bigbox', |
| 1443 : | "color"=> $color, | ||
| 1444 : | "zlayer" => '10', | ||
| 1445 : | "description" => $descriptions}; | ||
| 1446 : | |||
| 1447 : | push(@$line_data,$element_hash); | ||
| 1448 : | arodri7 | 1.28 | $gd->add_line($line_data, $line_config); |
| 1449 : | mkubal | 1.12 | } |
| 1450 : | |||
| 1451 : | return ($gd); | ||
| 1452 : | |||
| 1453 : | } | ||
| 1454 : | |||
| 1455 : | sub cleavage_loc { | ||
| 1456 : | my ($self) = @_; | ||
| 1457 : | |||
| 1458 : | return $self->{cleavage_loc}; | ||
| 1459 : | } | ||
| 1460 : | |||
| 1461 : | sub cleavage_prob { | ||
| 1462 : | my ($self) = @_; | ||
| 1463 : | |||
| 1464 : | return $self->{cleavage_prob}; | ||
| 1465 : | } | ||
| 1466 : | |||
| 1467 : | sub signal_peptide_score { | ||
| 1468 : | my ($self) = @_; | ||
| 1469 : | |||
| 1470 : | return $self->{signal_peptide_score}; | ||
| 1471 : | } | ||
| 1472 : | |||
| 1473 : | sub tmpred_score { | ||
| 1474 : | my ($self) = @_; | ||
| 1475 : | |||
| 1476 : | return $self->{tmpred_score}; | ||
| 1477 : | } | ||
| 1478 : | |||
| 1479 : | sub tmpred_locations { | ||
| 1480 : | my ($self) = @_; | ||
| 1481 : | |||
| 1482 : | return $self->{tmpred_locations}; | ||
| 1483 : | } | ||
| 1484 : | |||
| 1485 : | sub cello_location { | ||
| 1486 : | my ($self) = @_; | ||
| 1487 : | |||
| 1488 : | return $self->{cello_location}; | ||
| 1489 : | } | ||
| 1490 : | |||
| 1491 : | sub cello_score { | ||
| 1492 : | my ($self) = @_; | ||
| 1493 : | |||
| 1494 : | return $self->{cello_score}; | ||
| 1495 : | } | ||
| 1496 : | |||
| 1497 : | |||
| 1498 : | ######################################### | ||
| 1499 : | ######################################### | ||
| 1500 : | arodri7 | 1.10 | package Observation::Sims; |
| 1501 : | |||
| 1502 : | use base qw(Observation); | ||
| 1503 : | |||
| 1504 : | sub new { | ||
| 1505 : | |||
| 1506 : | my ($class,$dataset) = @_; | ||
| 1507 : | my $self = $class->SUPER::new($dataset); | ||
| 1508 : | arodri7 | 1.11 | $self->{identity} = $dataset->{'identity'}; |
| 1509 : | arodri7 | 1.10 | $self->{acc} = $dataset->{'acc'}; |
| 1510 : | $self->{evalue} = $dataset->{'evalue'}; | ||
| 1511 : | arodri7 | 1.11 | $self->{qstart} = $dataset->{'qstart'}; |
| 1512 : | $self->{qstop} = $dataset->{'qstop'}; | ||
| 1513 : | $self->{hstart} = $dataset->{'hstart'}; | ||
| 1514 : | $self->{hstop} = $dataset->{'hstop'}; | ||
| 1515 : | $self->{database} = $dataset->{'database'}; | ||
| 1516 : | $self->{organism} = $dataset->{'organism'}; | ||
| 1517 : | $self->{function} = $dataset->{'function'}; | ||
| 1518 : | $self->{qlength} = $dataset->{'qlength'}; | ||
| 1519 : | $self->{hlength} = $dataset->{'hlength'}; | ||
| 1520 : | arodri7 | 1.10 | |
| 1521 : | bless($self,$class); | ||
| 1522 : | return $self; | ||
| 1523 : | } | ||
| 1524 : | |||
| 1525 : | arodri7 | 1.25 | =head3 display() |
| 1526 : | |||
| 1527 : | If available use the function specified here to display a graphical observation. | ||
| 1528 : | This code will display a graphical view of the similarities using the genome drawer object | ||
| 1529 : | |||
| 1530 : | =cut | ||
| 1531 : | |||
| 1532 : | sub display { | ||
| 1533 : | my ($self,$gd) = @_; | ||
| 1534 : | |||
| 1535 : | my $fig = new FIG; | ||
| 1536 : | my $peg = $self->acc; | ||
| 1537 : | |||
| 1538 : | my $organism = $self->organism; | ||
| 1539 : | arodri7 | 1.28 | my $genome = $fig->genome_of($peg); |
| 1540 : | my ($org_tax) = ($genome) =~ /(.*)\./; | ||
| 1541 : | arodri7 | 1.25 | my $function = $self->function; |
| 1542 : | my $abbrev_name = $fig->abbrev($organism); | ||
| 1543 : | my $align_start = $self->qstart; | ||
| 1544 : | my $align_stop = $self->qstop; | ||
| 1545 : | my $hit_start = $self->hstart; | ||
| 1546 : | my $hit_stop = $self->hstop; | ||
| 1547 : | |||
| 1548 : | arodri7 | 1.28 | my $tax_link = "http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?id=" . $org_tax; |
| 1549 : | |||
| 1550 : | my $line_config = { 'title' => "$organism [$org_tax]", | ||
| 1551 : | arodri7 | 1.25 | 'short_title' => "$abbrev_name", |
| 1552 : | arodri7 | 1.28 | 'title_link' => '$tax_link', |
| 1553 : | arodri7 | 1.25 | 'basepair_offset' => '0' |
| 1554 : | }; | ||
| 1555 : | |||
| 1556 : | my $line_data = []; | ||
| 1557 : | |||
| 1558 : | my $element_hash; | ||
| 1559 : | my $links_list = []; | ||
| 1560 : | my $descriptions = []; | ||
| 1561 : | |||
| 1562 : | # get subsystem information | ||
| 1563 : | my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$peg; | ||
| 1564 : | |||
| 1565 : | my $link; | ||
| 1566 : | $link = {"link_title" => $peg, | ||
| 1567 : | "link" => $url_link}; | ||
| 1568 : | push(@$links_list,$link); | ||
| 1569 : | |||
| 1570 : | my @subsystems = $fig->peg_to_subsystems($peg); | ||
| 1571 : | foreach my $subsystem (@subsystems){ | ||
| 1572 : | my $link; | ||
| 1573 : | $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem", | ||
| 1574 : | "link_title" => $subsystem}; | ||
| 1575 : | push(@$links_list,$link); | ||
| 1576 : | } | ||
| 1577 : | |||
| 1578 : | my $description_function; | ||
| 1579 : | $description_function = {"title" => "function", | ||
| 1580 : | "value" => $function}; | ||
| 1581 : | push(@$descriptions,$description_function); | ||
| 1582 : | |||
| 1583 : | arodri7 | 1.26 | my ($description_ss, $ss_string); |
| 1584 : | $ss_string = join (",", @subsystems); | ||
| 1585 : | arodri7 | 1.25 | $description_ss = {"title" => "subsystems", |
| 1586 : | "value" => $ss_string}; | ||
| 1587 : | push(@$descriptions,$description_ss); | ||
| 1588 : | |||
| 1589 : | my $description_loc; | ||
| 1590 : | $description_loc = {"title" => "location start", | ||
| 1591 : | "value" => $hit_start}; | ||
| 1592 : | push(@$descriptions, $description_loc); | ||
| 1593 : | |||
| 1594 : | $description_loc = {"title" => "location stop", | ||
| 1595 : | "value" => $hit_stop}; | ||
| 1596 : | push(@$descriptions, $description_loc); | ||
| 1597 : | |||
| 1598 : | my $evalue = $self->evalue; | ||
| 1599 : | while ($evalue =~ /-0/) | ||
| 1600 : | { | ||
| 1601 : | my ($chunk1, $chunk2) = split(/-/, $evalue); | ||
| 1602 : | $chunk2 = substr($chunk2,1); | ||
| 1603 : | $evalue = $chunk1 . "-" . $chunk2; | ||
| 1604 : | } | ||
| 1605 : | |||
| 1606 : | arodri7 | 1.26 | my $color = &color($evalue); |
| 1607 : | arodri7 | 1.25 | |
| 1608 : | my $description_eval = {"title" => "E-Value", | ||
| 1609 : | "value" => $evalue}; | ||
| 1610 : | push(@$descriptions, $description_eval); | ||
| 1611 : | |||
| 1612 : | my $identity = $self->identity; | ||
| 1613 : | my $description_identity = {"title" => "Identity", | ||
| 1614 : | "value" => $identity}; | ||
| 1615 : | push(@$descriptions, $description_identity); | ||
| 1616 : | |||
| 1617 : | $element_hash = { | ||
| 1618 : | "title" => $peg, | ||
| 1619 : | "start" => $align_start, | ||
| 1620 : | "end" => $align_stop, | ||
| 1621 : | "type"=> 'box', | ||
| 1622 : | "color"=> $color, | ||
| 1623 : | "zlayer" => "2", | ||
| 1624 : | "links_list" => $links_list, | ||
| 1625 : | "description" => $descriptions | ||
| 1626 : | }; | ||
| 1627 : | push(@$line_data,$element_hash); | ||
| 1628 : | $gd->add_line($line_data, $line_config); | ||
| 1629 : | |||
| 1630 : | return ($gd); | ||
| 1631 : | |||
| 1632 : | } | ||
| 1633 : | |||
| 1634 : | mkubal | 1.24 | =head3 display_table() |
| 1635 : | arodri7 | 1.10 | |
| 1636 : | If available use the function specified here to display the "raw" observation. | ||
| 1637 : | This code will display a table for the similarities protein | ||
| 1638 : | |||
| 1639 : | B<Please note> that URL linked to in display_method() is an external component and needs to added to the code for every class of evidence. | ||
| 1640 : | |||
| 1641 : | =cut | ||
| 1642 : | |||
| 1643 : | mkubal | 1.24 | sub display_table { |
| 1644 : | arodri7 | 1.28 | my ($self,$dataset, $preference) = @_; |
| 1645 : | mkubal | 1.24 | |
| 1646 : | arodri7 | 1.10 | my $data = []; |
| 1647 : | my $count = 0; | ||
| 1648 : | my $content; | ||
| 1649 : | arodri7 | 1.11 | my $fig = new FIG; |
| 1650 : | mkubal | 1.24 | my $cgi = new CGI; |
| 1651 : | arodri7 | 1.28 | my @ids; |
| 1652 : | arodri7 | 1.10 | foreach my $thing (@$dataset) { |
| 1653 : | arodri7 | 1.28 | next if ($thing->class ne "SIM"); |
| 1654 : | push (@ids, $thing->acc); | ||
| 1655 : | } | ||
| 1656 : | |||
| 1657 : | # get the subsystem information as a batch request | ||
| 1658 : | my %in_subs = $fig->subsystems_for_pegs(\@ids); | ||
| 1659 : | |||
| 1660 : | # get the evidence information as a batch request | ||
| 1661 : | my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes(\@ids); | ||
| 1662 : | my %code_attributes; | ||
| 1663 : | foreach my $key (@codes){ | ||
| 1664 : | push (@{$code_attributes{$$key[0]}}, $key); | ||
| 1665 : | } | ||
| 1666 : | |||
| 1667 : | foreach my $thing (@$dataset) { | ||
| 1668 : | next if ($thing->class ne "SIM"); | ||
| 1669 : | arodri7 | 1.10 | my $single_domain = []; |
| 1670 : | $count++; | ||
| 1671 : | |||
| 1672 : | arodri7 | 1.11 | my $id = $thing->acc; |
| 1673 : | |||
| 1674 : | # add the subsystem information | ||
| 1675 : | arodri7 | 1.28 | #my @in_sub = $fig->peg_to_subsystems($id); |
| 1676 : | my @in_sub = $in_subs{$id} if (defined $in_subs{$id}); | ||
| 1677 : | arodri7 | 1.11 | my $in_sub; |
| 1678 : | arodri7 | 1.28 | |
| 1679 : | arodri7 | 1.11 | if (@in_sub > 0) { |
| 1680 : | $in_sub = @in_sub; | ||
| 1681 : | |||
| 1682 : | # RAE: add a javascript popup with all the subsystems | ||
| 1683 : | my $ss_list=join "<br>", map { my $g = $_; $g =~ s/\_/ /g; $_ = $g } sort {$a cmp $b} @in_sub; | ||
| 1684 : | $in_sub = $cgi->a( {id=>"subsystems", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Subsystems', '$ss_list', ''); this.tooltip.addHandler(); return false;"}, $in_sub); | ||
| 1685 : | } else { | ||
| 1686 : | $in_sub = " "; | ||
| 1687 : | } | ||
| 1688 : | |||
| 1689 : | # add evidence code with tool tip | ||
| 1690 : | my $ev_codes=" "; | ||
| 1691 : | my @ev_codes = ""; | ||
| 1692 : | arodri7 | 1.28 | |
| 1693 : | arodri7 | 1.11 | if ($id =~ /^fig\|\d+\.\d+\.peg\.\d+$/) { |
| 1694 : | arodri7 | 1.28 | my @codes; |
| 1695 : | @codes = @{$code_attributes{$id}} if (defined @{$code_attributes{$id}}); | ||
| 1696 : | arodri7 | 1.11 | @ev_codes = (); |
| 1697 : | foreach my $code (@codes) { | ||
| 1698 : | my $pretty_code = $code->[2]; | ||
| 1699 : | if ($pretty_code =~ /;/) { | ||
| 1700 : | my ($cd, $ss) = split(";", $code->[2]); | ||
| 1701 : | $ss =~ s/_/ /g; | ||
| 1702 : | $pretty_code = $cd;# . " in " . $ss; | ||
| 1703 : | } | ||
| 1704 : | push(@ev_codes, $pretty_code); | ||
| 1705 : | } | ||
| 1706 : | } | ||
| 1707 : | |||
| 1708 : | if (scalar(@ev_codes) && $ev_codes[0]) { | ||
| 1709 : | my $ev_code_help=join("<br />", map {&HTML::evidence_codes_explain($_)} @ev_codes); | ||
| 1710 : | $ev_codes = $cgi->a( | ||
| 1711 : | { | ||
| 1712 : | id=>"evidence_codes", onMouseover=>"javascript:if(!this.tooltip) this.tooltip=new Popup_Tooltip(this, 'Evidence Codes', '$ev_code_help', ''); this.tooltip.addHandler(); return false;"}, join("<br />", @ev_codes)); | ||
| 1713 : | } | ||
| 1714 : | |||
| 1715 : | my $iden = $thing->identity; | ||
| 1716 : | my $ln1 = $thing->qlength; | ||
| 1717 : | my $ln2 = $thing->hlength; | ||
| 1718 : | my $b1 = $thing->qstart; | ||
| 1719 : | my $e1 = $thing->qstop; | ||
| 1720 : | my $b2 = $thing->hstart; | ||
| 1721 : | my $e2 = $thing->hstop; | ||
| 1722 : | my $d1 = abs($e1 - $b1) + 1; | ||
| 1723 : | my $d2 = abs($e2 - $b2) + 1; | ||
| 1724 : | my $reg1 = "$b1-$e1 (<b>$d1/$ln1</b>)"; | ||
| 1725 : | my $reg2 = "$b2-$e2 (<b>$d2/$ln2</b>)"; | ||
| 1726 : | |||
| 1727 : | arodri7 | 1.26 | my $name = $thing->acc; |
| 1728 : | my $field_name = "tables_" . $name; | ||
| 1729 : | my $pair_name = "visual_" . $name; | ||
| 1730 : | arodri7 | 1.11 | |
| 1731 : | arodri7 | 1.26 | my $checkbox_col = qq(<input type=checkbox name=seq value="$name" id="$field_name" onClick="VisualCheckPair('$field_name', '$pair_name');">); |
| 1732 : | arodri7 | 1.28 | |
| 1733 : | my $prefer_id = &get_prefer($thing->acc, $preference); | ||
| 1734 : | my $acc_col .= &HTML::set_prot_links($cgi,$prefer_id); | ||
| 1735 : | my $db = $thing->database; | ||
| 1736 : | if ($preference ne "FIG"){ | ||
| 1737 : | $db = &Observation::get_database($prefer_id); | ||
| 1738 : | } | ||
| 1739 : | |||
| 1740 : | arodri7 | 1.26 | push(@$single_domain,$checkbox_col); |
| 1741 : | arodri7 | 1.28 | push(@$single_domain,$db); |
| 1742 : | arodri7 | 1.26 | push(@$single_domain,$acc_col); |
| 1743 : | arodri7 | 1.10 | push(@$single_domain,$thing->evalue); |
| 1744 : | arodri7 | 1.11 | push(@$single_domain,"$iden\%"); |
| 1745 : | push(@$single_domain,$reg1); | ||
| 1746 : | push(@$single_domain,$reg2); | ||
| 1747 : | push(@$single_domain,$in_sub); | ||
| 1748 : | push(@$single_domain,$ev_codes); | ||
| 1749 : | push(@$single_domain,$thing->organism); | ||
| 1750 : | push(@$single_domain,$thing->function); | ||
| 1751 : | arodri7 | 1.10 | push(@$data,$single_domain); |
| 1752 : | arodri7 | 1.26 | |
| 1753 : | arodri7 | 1.10 | } |
| 1754 : | |||
| 1755 : | arodri7 | 1.26 | if ($count >0 ){ |
| 1756 : | $content = $data; | ||
| 1757 : | arodri7 | 1.10 | } |
| 1758 : | arodri7 | 1.26 | else{ |
| 1759 : | arodri7 | 1.10 | $content = "<p>This PEG does not have any similarities</p>"; |
| 1760 : | } | ||
| 1761 : | return ($content); | ||
| 1762 : | } | ||
| 1763 : | arodri7 | 1.11 | |
| 1764 : | sub html_enc { $_ = $_[0]; s/\&/&/g; s/\>/>/g; s/\</</g; $_ } | ||
| 1765 : | mkubal | 1.12 | |
| 1766 : | arodri7 | 1.28 | sub get_prefer { |
| 1767 : | my ($fid, $db) = @_; | ||
| 1768 : | my $fig = new FIG; | ||
| 1769 : | |||
| 1770 : | my @aliases = $fig->feature_aliases($fid); | ||
| 1771 : | |||
| 1772 : | foreach my $alias (@aliases){ | ||
| 1773 : | my $id_db = &Observation::get_database($alias); | ||
| 1774 : | if ($id_db eq $db){ | ||
| 1775 : | return ($alias); | ||
| 1776 : | } | ||
| 1777 : | } | ||
| 1778 : | return ($fid); | ||
| 1779 : | } | ||
| 1780 : | |||
| 1781 : | arodri7 | 1.26 | sub color { |
| 1782 : | my ($evalue) = @_; | ||
| 1783 : | |||
| 1784 : | my $color; | ||
| 1785 : | arodri7 | 1.28 | if ($evalue <= 1e-170){ |
| 1786 : | $color = 51; | ||
| 1787 : | } | ||
| 1788 : | elsif (($evalue <= 1e-120) && ($evalue > 1e-170)){ | ||
| 1789 : | $color = 52; | ||
| 1790 : | } | ||
| 1791 : | elsif (($evalue <= 1e-90) && ($evalue > 1e-120)){ | ||
| 1792 : | $color = 53; | ||
| 1793 : | } | ||
| 1794 : | elsif (($evalue <= 1e-70) && ($evalue > 1e-90)){ | ||
| 1795 : | $color = 54; | ||
| 1796 : | arodri7 | 1.26 | } |
| 1797 : | arodri7 | 1.28 | elsif (($evalue <= 1e-40) && ($evalue > 1e-70)){ |
| 1798 : | $color = 55; | ||
| 1799 : | arodri7 | 1.26 | } |
| 1800 : | arodri7 | 1.28 | elsif (($evalue <= 1e-20) && ($evalue > 1e-40)){ |
| 1801 : | $color = 56; | ||
| 1802 : | arodri7 | 1.26 | } |
| 1803 : | arodri7 | 1.28 | elsif (($evalue <= 1e-5) && ($evalue > 1e-20)){ |
| 1804 : | $color = 57; | ||
| 1805 : | arodri7 | 1.26 | } |
| 1806 : | arodri7 | 1.28 | elsif (($evalue <= 1) && ($evalue > 1e-5)){ |
| 1807 : | $color = 58; | ||
| 1808 : | } | ||
| 1809 : | elsif (($evalue <= 10) && ($evalue > 1)){ | ||
| 1810 : | $color = 59; | ||
| 1811 : | arodri7 | 1.26 | } |
| 1812 : | else{ | ||
| 1813 : | arodri7 | 1.28 | $color = 60; |
| 1814 : | arodri7 | 1.26 | } |
| 1815 : | arodri7 | 1.28 | |
| 1816 : | |||
| 1817 : | arodri7 | 1.26 | return ($color); |
| 1818 : | } | ||
| 1819 : | arodri7 | 1.13 | |
| 1820 : | |||
| 1821 : | ############################ | ||
| 1822 : | package Observation::Cluster; | ||
| 1823 : | |||
| 1824 : | use base qw(Observation); | ||
| 1825 : | |||
| 1826 : | sub new { | ||
| 1827 : | |||
| 1828 : | my ($class,$dataset) = @_; | ||
| 1829 : | my $self = $class->SUPER::new($dataset); | ||
| 1830 : | mkubal | 1.24 | $self->{context} = $dataset->{'context'}; |
| 1831 : | arodri7 | 1.13 | bless($self,$class); |
| 1832 : | return $self; | ||
| 1833 : | } | ||
| 1834 : | |||
| 1835 : | sub display { | ||
| 1836 : | mkubal | 1.24 | my ($self,$gd) = @_; |
| 1837 : | |||
| 1838 : | my $fid = $self->fig_id; | ||
| 1839 : | my $compare_or_coupling = $self->context; | ||
| 1840 : | my $gd_window_size = $gd->window_size; | ||
| 1841 : | arodri7 | 1.13 | my $fig = new FIG; |
| 1842 : | mkubal | 1.14 | my $all_regions = []; |
| 1843 : | arodri7 | 1.13 | |
| 1844 : | #get the organism genome | ||
| 1845 : | mkubal | 1.14 | my $target_genome = $fig->genome_of($fid); |
| 1846 : | arodri7 | 1.13 | |
| 1847 : | # get location of the gene | ||
| 1848 : | my $data = $fig->feature_location($fid); | ||
| 1849 : | my ($contig, $beg, $end); | ||
| 1850 : | arodri7 | 1.22 | my %reverse_flag; |
| 1851 : | arodri7 | 1.13 | |
| 1852 : | if ($data =~ /(.*)_(\d+)_(\d+)$/){ | ||
| 1853 : | $contig = $1; | ||
| 1854 : | $beg = $2; | ||
| 1855 : | $end = $3; | ||
| 1856 : | } | ||
| 1857 : | |||
| 1858 : | arodri7 | 1.22 | my $offset; |
| 1859 : | arodri7 | 1.13 | my ($region_start, $region_end); |
| 1860 : | if ($beg < $end) | ||
| 1861 : | { | ||
| 1862 : | $region_start = $beg - 4000; | ||
| 1863 : | $region_end = $end+4000; | ||
| 1864 : | arodri7 | 1.22 | $offset = ($2+(($3-$2)/2))-($gd_window_size/2); |
| 1865 : | arodri7 | 1.13 | } |
| 1866 : | else | ||
| 1867 : | { | ||
| 1868 : | arodri7 | 1.21 | $region_start = $end-4000; |
| 1869 : | $region_end = $beg+4000; | ||
| 1870 : | arodri7 | 1.22 | $offset = ($3+(($2-$3)/2))-($gd_window_size/2); |
| 1871 : | arodri7 | 1.25 | $reverse_flag{$target_genome} = $fid; |
| 1872 : | arodri7 | 1.21 | } |
| 1873 : | arodri7 | 1.13 | |
| 1874 : | # call genes in region | ||
| 1875 : | arodri7 | 1.16 | my ($target_gene_features, $reg_beg, $reg_end) = $fig->genes_in_region($target_genome, $contig, $region_start, $region_end); |
| 1876 : | mkubal | 1.14 | push(@$all_regions,$target_gene_features); |
| 1877 : | arodri7 | 1.16 | my (@start_array_region); |
| 1878 : | arodri7 | 1.22 | push (@start_array_region, $offset); |
| 1879 : | mkubal | 1.14 | |
| 1880 : | my %all_genes; | ||
| 1881 : | my %all_genomes; | ||
| 1882 : | arodri7 | 1.25 | foreach my $feature (@$target_gene_features){ $all_genes{$feature} = $fid;} |
| 1883 : | arodri7 | 1.16 | |
| 1884 : | mkubal | 1.24 | if ($compare_or_coupling eq "diverse") |
| 1885 : | arodri7 | 1.25 | { |
| 1886 : | arodri7 | 1.21 | my @coup = grep { $_->[1]} $fig->coupling_and_evidence($fid,5000,1e-10,4,1); |
| 1887 : | |||
| 1888 : | my $coup_count = 0; | ||
| 1889 : | |||
| 1890 : | foreach my $pair (@{$coup[0]->[2]}) { | ||
| 1891 : | # last if ($coup_count > 10); | ||
| 1892 : | my ($peg1,$peg2) = @$pair; | ||
| 1893 : | arodri7 | 1.22 | |
| 1894 : | my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome); | ||
| 1895 : | $pair_genome = $fig->genome_of($peg1); | ||
| 1896 : | arodri7 | 1.21 | |
| 1897 : | my $location = $fig->feature_location($peg1); | ||
| 1898 : | if($location =~/(.*)_(\d+)_(\d+)$/){ | ||
| 1899 : | $pair_contig = $1; | ||
| 1900 : | $pair_beg = $2; | ||
| 1901 : | $pair_end = $3; | ||
| 1902 : | if ($pair_beg < $pair_end) | ||
| 1903 : | { | ||
| 1904 : | $pair_region_start = $pair_beg - 4000; | ||
| 1905 : | $pair_region_stop = $pair_end+4000; | ||
| 1906 : | arodri7 | 1.22 | $offset = ($2+(($3-$2)/2))-($gd_window_size/2); |
| 1907 : | arodri7 | 1.21 | } |
| 1908 : | else | ||
| 1909 : | { | ||
| 1910 : | $pair_region_start = $pair_end-4000; | ||
| 1911 : | $pair_region_stop = $pair_beg+4000; | ||
| 1912 : | arodri7 | 1.22 | $offset = ($3+(($2-$3)/2))-($gd_window_size/2); |
| 1913 : | arodri7 | 1.25 | $reverse_flag{$pair_genome} = $peg1; |
| 1914 : | arodri7 | 1.21 | } |
| 1915 : | |||
| 1916 : | arodri7 | 1.22 | push (@start_array_region, $offset); |
| 1917 : | arodri7 | 1.21 | |
| 1918 : | $all_genomes{$pair_genome} = 1; | ||
| 1919 : | my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop); | ||
| 1920 : | push(@$all_regions,$pair_features); | ||
| 1921 : | arodri7 | 1.25 | foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;} |
| 1922 : | arodri7 | 1.21 | } |
| 1923 : | $coup_count++; | ||
| 1924 : | } | ||
| 1925 : | } | ||
| 1926 : | arodri7 | 1.16 | |
| 1927 : | mkubal | 1.24 | elsif ($compare_or_coupling eq "close") |
| 1928 : | arodri7 | 1.21 | { |
| 1929 : | # make a hash of genomes that are phylogenetically close | ||
| 1930 : | #my $close_threshold = ".26"; | ||
| 1931 : | #my @genomes = $fig->genomes('complete'); | ||
| 1932 : | #my %close_genomes = (); | ||
| 1933 : | #foreach my $compared_genome (@genomes) | ||
| 1934 : | #{ | ||
| 1935 : | # my $dist = $fig->crude_estimate_of_distance($target_genome,$compared_genome); | ||
| 1936 : | # #$close_genomes{$compared_genome} = $dist; | ||
| 1937 : | # if ($dist <= $close_threshold) | ||
| 1938 : | # { | ||
| 1939 : | # $all_genomes{$compared_genome} = 1; | ||
| 1940 : | # } | ||
| 1941 : | #} | ||
| 1942 : | $all_genomes{"216592.1"} = 1; | ||
| 1943 : | $all_genomes{"79967.1"} = 1; | ||
| 1944 : | $all_genomes{"199310.1"} = 1; | ||
| 1945 : | $all_genomes{"216593.1"} = 1; | ||
| 1946 : | $all_genomes{"155864.1"} = 1; | ||
| 1947 : | $all_genomes{"83334.1"} = 1; | ||
| 1948 : | $all_genomes{"316407.3"} = 1; | ||
| 1949 : | |||
| 1950 : | foreach my $comp_genome (keys %all_genomes){ | ||
| 1951 : | my $return = $fig->bbh_list($comp_genome,[$fid]); | ||
| 1952 : | my $feature_list = $return->{$fid}; | ||
| 1953 : | foreach my $peg1 (@$feature_list){ | ||
| 1954 : | my $location = $fig->feature_location($peg1); | ||
| 1955 : | my ($pair_contig,$pair_beg,$pair_end,$pair_region_start,$pair_region_stop,$pair_genome); | ||
| 1956 : | arodri7 | 1.22 | $pair_genome = $fig->genome_of($peg1); |
| 1957 : | |||
| 1958 : | arodri7 | 1.21 | if($location =~/(.*)_(\d+)_(\d+)$/){ |
| 1959 : | $pair_contig = $1; | ||
| 1960 : | $pair_beg = $2; | ||
| 1961 : | $pair_end = $3; | ||
| 1962 : | if ($pair_beg < $pair_end) | ||
| 1963 : | { | ||
| 1964 : | $pair_region_start = $pair_beg - 4000; | ||
| 1965 : | $pair_region_stop = $pair_end + 4000; | ||
| 1966 : | arodri7 | 1.22 | $offset = ($2+(($3-$2)/2))-($gd_window_size/2); |
| 1967 : | arodri7 | 1.21 | } |
| 1968 : | else | ||
| 1969 : | { | ||
| 1970 : | $pair_region_start = $pair_end-4000; | ||
| 1971 : | $pair_region_stop = $pair_beg+4000; | ||
| 1972 : | arodri7 | 1.22 | $offset = ($3+(($2-$3)/2))-($gd_window_size/2); |
| 1973 : | arodri7 | 1.25 | $reverse_flag{$pair_genome} = $peg1; |
| 1974 : | arodri7 | 1.21 | } |
| 1975 : | |||
| 1976 : | arodri7 | 1.22 | push (@start_array_region, $offset); |
| 1977 : | arodri7 | 1.21 | $all_genomes{$pair_genome} = 1; |
| 1978 : | my ($pair_features) = $fig->genes_in_region($pair_genome, $pair_contig, $pair_region_start, $pair_region_stop); | ||
| 1979 : | push(@$all_regions,$pair_features); | ||
| 1980 : | arodri7 | 1.25 | foreach my $pair_feature (@$pair_features){ $all_genes{$pair_feature} = $peg1;} |
| 1981 : | arodri7 | 1.21 | } |
| 1982 : | mkubal | 1.14 | } |
| 1983 : | arodri7 | 1.16 | } |
| 1984 : | mkubal | 1.14 | } |
| 1985 : | |||
| 1986 : | arodri7 | 1.21 | # get the PCH to each of the genes |
| 1987 : | my $pch_sets = []; | ||
| 1988 : | my %pch_already; | ||
| 1989 : | foreach my $gene_peg (keys %all_genes) | ||
| 1990 : | { | ||
| 1991 : | if ($pch_already{$gene_peg}){next;}; | ||
| 1992 : | my $gene_set = [$gene_peg]; | ||
| 1993 : | foreach my $pch_peg ($fig->in_pch_pin_with($gene_peg)) { | ||
| 1994 : | $pch_peg =~ s/,.*$//; | ||
| 1995 : | my $pch_genome = $fig->genome_of($pch_peg); | ||
| 1996 : | if ( ($gene_peg ne $pch_peg) && ($all_genomes{$pch_genome})) { | ||
| 1997 : | push(@$gene_set,$pch_peg); | ||
| 1998 : | $pch_already{$pch_peg}=1; | ||
| 1999 : | mkubal | 1.14 | } |
| 2000 : | arodri7 | 1.21 | $pch_already{$gene_peg}=1; |
| 2001 : | mkubal | 1.14 | } |
| 2002 : | arodri7 | 1.21 | push(@$pch_sets,$gene_set); |
| 2003 : | mkubal | 1.14 | } |
| 2004 : | arodri7 | 1.21 | |
| 2005 : | #create a rank of the pch's | ||
| 2006 : | my %pch_set_rank; | ||
| 2007 : | mkubal | 1.14 | my $order = 0; |
| 2008 : | arodri7 | 1.21 | foreach my $set (@$pch_sets){ |
| 2009 : | mkubal | 1.14 | my $count = scalar(@$set); |
| 2010 : | arodri7 | 1.21 | $pch_set_rank{$order} = $count; |
| 2011 : | mkubal | 1.14 | $order++; |
| 2012 : | } | ||
| 2013 : | arodri7 | 1.21 | |
| 2014 : | mkubal | 1.14 | my %peg_rank; |
| 2015 : | my $counter = 1; | ||
| 2016 : | arodri7 | 1.21 | foreach my $pch_order (sort {$pch_set_rank{$b} <=> $pch_set_rank{$a}} keys %pch_set_rank){ |
| 2017 : | my $good_set = @$pch_sets[$pch_order]; | ||
| 2018 : | arodri7 | 1.18 | my $flag_set = 0; |
| 2019 : | if (scalar (@$good_set) > 1) | ||
| 2020 : | { | ||
| 2021 : | foreach my $peg (@$good_set){ | ||
| 2022 : | if ((!$peg_rank{$peg})){ | ||
| 2023 : | $peg_rank{$peg} = $counter; | ||
| 2024 : | $flag_set = 1; | ||
| 2025 : | } | ||
| 2026 : | } | ||
| 2027 : | $counter++ if ($flag_set == 1); | ||
| 2028 : | } | ||
| 2029 : | else | ||
| 2030 : | { | ||
| 2031 : | foreach my $peg (@$good_set){ | ||
| 2032 : | arodri7 | 1.26 | $peg_rank{$peg} = "20"; |
| 2033 : | mkubal | 1.17 | } |
| 2034 : | mkubal | 1.14 | } |
| 2035 : | } | ||
| 2036 : | arodri7 | 1.21 | |
| 2037 : | |||
| 2038 : | # my $bbh_sets = []; | ||
| 2039 : | # my %already; | ||
| 2040 : | # foreach my $gene_key (keys(%all_genes)){ | ||
| 2041 : | # if($already{$gene_key}){next;} | ||
| 2042 : | # my $gene_set = [$gene_key]; | ||
| 2043 : | # | ||
| 2044 : | # my $gene_key_genome = $fig->genome_of($gene_key); | ||
| 2045 : | # | ||
| 2046 : | # foreach my $genome_key (keys(%all_genomes)){ | ||
| 2047 : | # #next if ($gene_key_genome eq $genome_key); | ||
| 2048 : | # my $return = $fig->bbh_list($genome_key,[$gene_key]); | ||
| 2049 : | # | ||
| 2050 : | # my $feature_list = $return->{$gene_key}; | ||
| 2051 : | # foreach my $fl (@$feature_list){ | ||
| 2052 : | # push(@$gene_set,$fl); | ||
| 2053 : | # } | ||
| 2054 : | # } | ||
| 2055 : | # $already{$gene_key} = 1; | ||
| 2056 : | # push(@$bbh_sets,$gene_set); | ||
| 2057 : | # } | ||
| 2058 : | # | ||
| 2059 : | # my %bbh_set_rank; | ||
| 2060 : | # my $order = 0; | ||
| 2061 : | # foreach my $set (@$bbh_sets){ | ||
| 2062 : | # my $count = scalar(@$set); | ||
| 2063 : | # $bbh_set_rank{$order} = $count; | ||
| 2064 : | # $order++; | ||
| 2065 : | # } | ||
| 2066 : | # | ||
| 2067 : | # my %peg_rank; | ||
| 2068 : | # my $counter = 1; | ||
| 2069 : | # foreach my $bbh_order (sort {$bbh_set_rank{$b} <=> $bbh_set_rank{$a}} keys %bbh_set_rank){ | ||
| 2070 : | # my $good_set = @$bbh_sets[$bbh_order]; | ||
| 2071 : | # my $flag_set = 0; | ||
| 2072 : | # if (scalar (@$good_set) > 1) | ||
| 2073 : | # { | ||
| 2074 : | # foreach my $peg (@$good_set){ | ||
| 2075 : | # if ((!$peg_rank{$peg})){ | ||
| 2076 : | # $peg_rank{$peg} = $counter; | ||
| 2077 : | # $flag_set = 1; | ||
| 2078 : | # } | ||
| 2079 : | # } | ||
| 2080 : | # $counter++ if ($flag_set == 1); | ||
| 2081 : | # } | ||
| 2082 : | # else | ||
| 2083 : | # { | ||
| 2084 : | # foreach my $peg (@$good_set){ | ||
| 2085 : | arodri7 | 1.26 | # $peg_rank{$peg} = "20"; |
| 2086 : | arodri7 | 1.21 | # } |
| 2087 : | # } | ||
| 2088 : | # } | ||
| 2089 : | arodri7 | 1.18 | |
| 2090 : | mkubal | 1.14 | foreach my $region (@$all_regions){ |
| 2091 : | my $sample_peg = @$region[0]; | ||
| 2092 : | my $region_genome = $fig->genome_of($sample_peg); | ||
| 2093 : | my $region_gs = $fig->genus_species($region_genome); | ||
| 2094 : | arodri7 | 1.18 | my $abbrev_name = $fig->abbrev($region_gs); |
| 2095 : | arodri7 | 1.16 | my $line_config = { 'title' => $region_gs, |
| 2096 : | arodri7 | 1.18 | 'short_title' => $abbrev_name, |
| 2097 : | arodri7 | 1.16 | 'basepair_offset' => '0' |
| 2098 : | }; | ||
| 2099 : | |||
| 2100 : | arodri7 | 1.22 | my $offsetting = shift @start_array_region; |
| 2101 : | arodri7 | 1.16 | |
| 2102 : | arodri7 | 1.25 | my $second_line_config = { 'title' => "$region_gs", |
| 2103 : | 'short_title' => "", | ||
| 2104 : | 'basepair_offset' => '0' | ||
| 2105 : | }; | ||
| 2106 : | |||
| 2107 : | mkubal | 1.14 | my $line_data = []; |
| 2108 : | arodri7 | 1.25 | my $second_line_data = []; |
| 2109 : | |||
| 2110 : | # initialize variables to check for overlap in genes | ||
| 2111 : | my ($prev_start, $prev_stop, $prev_fig, $second_line_flag); | ||
| 2112 : | my $major_line_flag = 0; | ||
| 2113 : | my $prev_second_flag = 0; | ||
| 2114 : | |||
| 2115 : | arodri7 | 1.16 | foreach my $fid1 (@$region){ |
| 2116 : | arodri7 | 1.25 | $second_line_flag = 0; |
| 2117 : | mkubal | 1.14 | my $element_hash; |
| 2118 : | my $links_list = []; | ||
| 2119 : | my $descriptions = []; | ||
| 2120 : | |||
| 2121 : | arodri7 | 1.16 | my $color = $peg_rank{$fid1}; |
| 2122 : | arodri7 | 1.26 | |
| 2123 : | arodri7 | 1.18 | # get subsystem information |
| 2124 : | my $function = $fig->function_of($fid1); | ||
| 2125 : | my $url_link = "http://seed-viewer.theseed.org/index.cgi?action=ShowAnnotation&prot=".$fid1; | ||
| 2126 : | |||
| 2127 : | my $link; | ||
| 2128 : | $link = {"link_title" => $fid1, | ||
| 2129 : | "link" => $url_link}; | ||
| 2130 : | push(@$links_list,$link); | ||
| 2131 : | |||
| 2132 : | my @subsystems = $fig->peg_to_subsystems($fid1); | ||
| 2133 : | foreach my $subsystem (@subsystems){ | ||
| 2134 : | my $link; | ||
| 2135 : | $link = {"link" => "http://seed-viewer.theseed.org/index.cgi?action=ShowSubsystem&subsystem_name=$subsystem", | ||
| 2136 : | "link_title" => $subsystem}; | ||
| 2137 : | push(@$links_list,$link); | ||
| 2138 : | } | ||
| 2139 : | |||
| 2140 : | my $description_function; | ||
| 2141 : | $description_function = {"title" => "function", | ||
| 2142 : | "value" => $function}; | ||
| 2143 : | push(@$descriptions,$description_function); | ||
| 2144 : | |||
| 2145 : | my $description_ss; | ||
| 2146 : | my $ss_string = join (",", @subsystems); | ||
| 2147 : | $description_ss = {"title" => "subsystems", | ||
| 2148 : | "value" => $ss_string}; | ||
| 2149 : | push(@$descriptions,$description_ss); | ||
| 2150 : | |||
| 2151 : | arodri7 | 1.16 | |
| 2152 : | my $fid_location = $fig->feature_location($fid1); | ||
| 2153 : | mkubal | 1.14 | if($fid_location =~/(.*)_(\d+)_(\d+)$/){ |
| 2154 : | my($start,$stop); | ||
| 2155 : | arodri7 | 1.22 | $start = $2 - $offsetting; |
| 2156 : | $stop = $3 - $offsetting; | ||
| 2157 : | arodri7 | 1.25 | |
| 2158 : | if ( (($prev_start) && ($prev_stop) ) && | ||
| 2159 : | ( ($start < $prev_start) || ($start < $prev_stop) || | ||
| 2160 : | ($stop < $prev_start) || ($stop < $prev_stop) )){ | ||
| 2161 : | if (($second_line_flag == 0) && ($prev_second_flag == 0)) { | ||
| 2162 : | $second_line_flag = 1; | ||
| 2163 : | $major_line_flag = 1; | ||
| 2164 : | } | ||
| 2165 : | } | ||
| 2166 : | $prev_start = $start; | ||
| 2167 : | $prev_stop = $stop; | ||
| 2168 : | $prev_fig = $fid1; | ||
| 2169 : | |||
| 2170 : | if ((defined($reverse_flag{$region_genome})) && ($reverse_flag{$region_genome} eq $all_genes{$fid1})){ | ||
| 2171 : | arodri7 | 1.22 | $start = $gd_window_size - $start; |
| 2172 : | $stop = $gd_window_size - $stop; | ||
| 2173 : | } | ||
| 2174 : | |||
| 2175 : | mkubal | 1.14 | $element_hash = { |
| 2176 : | arodri7 | 1.16 | "title" => $fid1, |
| 2177 : | mkubal | 1.14 | "start" => $start, |
| 2178 : | "end" => $stop, | ||
| 2179 : | "type"=> 'arrow', | ||
| 2180 : | "color"=> $color, | ||
| 2181 : | arodri7 | 1.18 | "zlayer" => "2", |
| 2182 : | "links_list" => $links_list, | ||
| 2183 : | "description" => $descriptions | ||
| 2184 : | mkubal | 1.14 | }; |
| 2185 : | arodri7 | 1.25 | |
| 2186 : | # if there is an overlap, put into second line | ||
| 2187 : | if ($second_line_flag == 1){ push(@$second_line_data,$element_hash); $prev_second_flag = 1;} | ||
| 2188 : | else{ push(@$line_data,$element_hash); $prev_second_flag = 0;} | ||
| 2189 : | |||
| 2190 : | mkubal | 1.14 | } |
| 2191 : | } | ||
| 2192 : | $gd->add_line($line_data, $line_config); | ||
| 2193 : | arodri7 | 1.25 | $gd->add_line($second_line_data, $second_line_config) if ($major_line_flag == 1); |
| 2194 : | mkubal | 1.14 | } |
| 2195 : | return $gd; | ||
| 2196 : | } | ||
| 2197 : | |||
| 2198 : |
| MCS Webmaster | ViewVC Help |
| Powered by ViewVC 1.0.3 |