jpred/lib/DSSP/SCOP.pm

   1 package DSSP::SCOP;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6 use Scalar::Util qw(looks_like_number);
   7
   8 use base qw(DSSP);
   9 use Utils qw($split_resid sort_resid);
  10
  11 =head1 NAME
  12
  13 DSSP::SCOP - Module to select DSSP records from SCOP description
  14
  15 =head1 SYNOPSIS
  16
  17   my $dssp = DSSP::SCOP->new(read_file => "foo.dssp");
  18   my @range = $dssp->get_range("A:33-416");
  19
  20 =head1 DESCRIPTION
  21
  22 A module that provides a method of selecting a range of residues from a DSSP file. The description of the range is in the format used by SCOP version 1.65 in the dir.des file.
  23
  24 =head1 METHODS
  25
  26 The module inherits all the methods from the DSSP module.
  27
  28 =head2 $dssp->get_range("A:1-200,B:1-30")
  29
  30 Returns the DSSP::Position objects from within the range given. These are in the same order as they are presented in the DSSP file. They are returned as an array of array's, with each range having it's own array.
  31
  32 =cut
  33
  34 sub get_range {
  35         my ($self, $defn) = @_;
  36
  37         $defn =~ / / and croak "get_range('$defn') has a space in it, which isn't allowed";
  38         my @ranges = split /,/, $defn;
  39
  40         my @data;
  41         for (@ranges) {
  42                 my @range;
  43                 # A:1-200 or A:
  44                 if (/:/) {
  45                         my ($chain, $range) = split /:/, $_;
  46
  47                         # A:1-200
  48                         if ($range =~ /([[:alnum:]]+)-([[:alnum:]]+)/) {
  49                                 push @data, [ $self->select_positions($chain, $1, $2) ];
  50                         }
  51                         # Hmmmmm.
  52                         elsif ($range) {
  53                                 confess "You shouldn't be here";
  54                         }
  55                         # A:
  56                         else {
  57                                 push @data, [ $self->get_chain_defs($chain) ];
  58                         }
  59                 }
  60                 else {
  61                         # 297-368
  62                         if (/([[:alnum:]]+)-([[:alnum:]]+)/) {
  63                                 my @chains = $self->chains;
  64                                 if (@chains > 1) {
  65                                         die "Don't know which chain to select"
  66                                 }
  67                                 my ($chain) = @chains;
  68
  69                                 push @data, [ $self->select_positions($chain, $1, $2) ];
  70                         }
  71                         # -
  72                         elsif (/^-$/) {
  73                                 for my $chain ($self->chains) {
  74                                         push @data, [ $self->get_chain_defs($chain) ];
  75                                 }
  76                         }
  77                         # Otherwise we don't know what it is
  78                         else {
  79                                 confess "Missed particular '$_'";
  80                         }
  81                 }
  82         }
  83
  84         return @data;
  85 }
  86
  87 =head2 $self->select_positions($chain, $start, $end);
  88
  89 Passed a chain
  90
  91 # Select those, $chain, $start, $end;
  92
  93 =cut
  94
  95 sub select_positions {
  96         my ($self, $chain, $start, $end) = @_;
  97
  98         confess "Not passed all arguments" if grep { not defined } $chain, $start, $end;
  99         confess "Not passed a valid chain" unless grep { $_ eq $chain } $self->chains;
 100
 101         my ($flag, @positions) = 0;
 102         my $test = sub {
 103                 my ($off, $start, $end) = @_;
 104                 if (3 == grep { looks_like_number $_ } $off, $start, $end) {
 105                         return 1 if $off >= $start and $off <= $end;
 106                 }
 107                 else {
 108                         return undef;
 109                 }
 110         };
 111
 112         for my $pos ($self->get_chain_defs($chain)) {
 113                 if ($pos->break) {
 114                         push @positions, $pos if $flag;
 115                         next;
 116                 }
 117
 118                 my $off = $pos->off;
 119                 if (
 120                         ($off eq $start or $test->($off, $start, $end))
 121                         ..
 122                         ($off eq $end or $test->($off, $start, $end))
 123         #       $test($off, $start, $end) $off >= $start and $off <= $end)
 124         #($off eq $start or )
 125                 ) {
 126                         push @positions, $pos;
 127                         $flag = 1;
 128                 }
 129                 else { $flag = 0 }
 130         }
 131         return @positions;
 132 }
 133
 134 1;