Bio/Phenotype/MeSH/Twig.pm

   1 #
   2 # BioPerl module for Bio::Phenotype::MeSH::Twig
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
   7 #
   8 # You may distribute this module under the same terms as perl itself
   9
  10 # POD documentation - main docs before the code
  11
  12 =head1 NAME
  13
  14 Bio::Phenotype::MeSH::Twig - Context for a MeSH term
  15
  16 =head1 SYNOPSIS
  17
  18   use Bio::Phenotype::MeSH::Twig
  19   # create a twig object
  20   my $twig = Bio::Phenotype::MeSH::Twig->new();
  21
  22   # the term has only one parent in any twig
  23   $twig->parent('Fats');
  24
  25
  26   # a twig makeas sense only in the context of a term
  27   # which is a  Bio::Phenotype::MeSH::Term object
  28
  29   # a term can have many twigs i.e. it can appear in many places in
  30   # the hierarchy
  31   #
  32   $ term->add_twig($twig);
  33
  34   # adding the twig into a term adds a link into into it
  35   $twig->term eq $term;
  36
  37   # a twig can know about other terms under the parant node
  38   $twig->add_sister('Bread', 'Candy', 'Cereals');
  39   print join ( ', ', $twig->each_sister()), "\n";
  40
  41   # a twig can know about other terms under this term
  42   $twig->add_child('Butter', 'Margarine');
  43   print join ( ', ', $twig->each_child()), "\n";
  44
  45
  46
  47 =head1 DESCRIPTION
  48
  49 This class represents the immediate surrounding of a MeSH term. It
  50 keeps track on nodes names above the current node ('parent') other
  51 nodes at the same level ('sisters') and nodes under it ('children').
  52 Note that these are name strings, not objects.
  53
  54 Each twig can be associated with only one term, but term can have
  55 multiple twigs. (Twigs can be though to be roles for a term.)
  56
  57 =head1 SEE ALSO
  58
  59 L<Bio::Phenotype::MeSH::Term>
  60
  61 =head1 FEEDBACK
  62
  63 =head2 Mailing Lists
  64
  65 User feedback is an integral part of the evolution of this and other
  66 Bioperl modules. Send your comments and suggestions preferably to the
  67 Bioperl mailing lists  Your participation is much appreciated.
  68
  69   bioperl-l@bioperl.org                  - General discussion
  70   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  71
  72 =head2 Support
  73
  74 Please direct usage questions or support issues to the mailing list:
  75
  76 I<bioperl-l@bioperl.org>
  77
  78 rather than to the module maintainer directly. Many experienced and
  79 reponsive experts will be able look at the problem and quickly
  80 address it. Please include a thorough description of the problem
  81 with code and data examples if at all possible.
  82
  83 =head2 Reporting Bugs
  84
  85 report bugs to the Bioperl bug tracking system to help us keep track
  86 the bugs and their resolution.  Bug reports can be submitted via the
  87 web:
  88
  89   https://github.com/bioperl/bioperl-live/issues
  90
  91 =head1 AUTHOR
  92
  93 Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
  94
  95 =head1 APPENDIX
  96
  97 The rest of the documentation details each of the object
  98 methods. Internal methods are usually preceded with a _
  99
 100 =cut
 101
 102
 103 # Let the code begin...
 104
 105 package Bio::Phenotype::MeSH::Twig;
 106 use strict;
 107
 108
 109 use base qw(Bio::Root::Root);
 110
 111
 112 sub new {
 113
 114     my( $class,@args ) = @_;
 115     my $self = $class->SUPER::new( @args );
 116
 117     my ($term, $parent ) = $self->_rearrange
 118         ( [ qw(
 119                TERM
 120                PARENT
 121               ) ],
 122           @args );
 123
 124     $self->{"_children"} = [];
 125     $self->{"_sisters"} = [];
 126
 127     $term && $self->term($term );
 128     $parent  && $self->parent($parent );
 129     return $self;
 130 }
 131
 132
 133 =head2 parent
 134
 135  Title   : parent
 136  Usage   : $obj->parent( "r1" );
 137            or
 138            print $obj->parent();
 139  Function: Set/get for the parent.
 140  Returns : A parent [scalar].
 141  Args    : A parent [scalar] (optional).
 142
 143 =cut
 144
 145 sub parent {
 146     my ( $self, $value ) = @_;
 147     $self->{ "_parent" } = $value if defined $value;
 148     return $self->{ "_parent" };
 149 }
 150
 151 =head2 term
 152
 153  Title   : term
 154  Usage   : $obj->term( "r1" );
 155            or
 156            print $obj->term();
 157  Function: Set/get for the term.
 158  Returns : A term [scalar].
 159  Args    : A term [scalar] (optional).
 160
 161 =cut
 162
 163 sub term {
 164     my ( $self, $value ) = @_;
 165     if (defined $value) {
 166         $self->throw ("Not a MeSH term [$value]")
 167             unless $value->isa('Bio::Phenotype::MeSH::Term');
 168         $self->{ "_term" } = $value
 169     }
 170     return $self->{ "_term" };
 171 }
 172
 173
 174 =head2 add_child
 175
 176  Title   : add_child
 177  Usage   : $obj->add_child( @children );
 178            or
 179            $obj->add_child( $child );
 180  Function: Pushes one or more child term names [scalars, most likely Strings]
 181            into the list of children.
 182  Returns :
 183  Args    : scalar(s).
 184
 185 =cut
 186
 187 sub add_child {
 188     my ( $self, @values ) = @_;
 189     push( @{ $self->{ "_children" } }, @values );
 190     return scalar @values;
 191 }
 192
 193 =head2 each_child
 194
 195  Title   : each_child()
 196  Usage   : @gs = $obj->each_child();
 197  Function: Returns a list of gene symbols [scalars, most likely Strings]
 198            associated with this phenotype.
 199  Returns : A list of scalars.
 200  Args    :
 201
 202 =cut
 203
 204 sub each_child {
 205     my ( $self ) = shift;
 206     return @{ $self->{ "_children" } };
 207 }
 208
 209 =head2 purge_children
 210
 211  Usage   : $obj->purge_child();
 212  Function: Deletes  the list of children associated with this term.
 213  Returns : A list of scalars.
 214  Args    :
 215
 216 =cut
 217
 218 sub purge_children {
 219     my ( $self ) = @_;
 220     $self->{ "_children" } = [];
 221 }
 222
 223
 224 =head2 add_sister
 225
 226  Title   : add_sister
 227  Usage   : $obj->add_sister( @sisters );
 228            or
 229            $obj->add_sister( $sister );
 230  Function: Pushes one or more sister term names [scalars, most likely Strings]
 231            into the list of sisters.
 232  Returns :
 233  Args    : scalar(s).
 234
 235 =cut
 236
 237 sub add_sister {
 238     my ( $self, @values ) = @_;
 239     push( @{ $self->{ "_sisters" } }, @values );
 240     return scalar @values;
 241 }
 242
 243 =head2 each_sister
 244
 245  Title   : each_sister()
 246  Usage   : @gs = $obj->each_sister();
 247  Function: Returns a list of gene symbols [scalars, most likely Strings]
 248            associated with this phenotype.
 249  Returns : A list of scalars.
 250  Args    :
 251
 252 =cut
 253
 254 sub each_sister {
 255     my ( $self ) = shift;
 256     return @{ $self->{ "_sisters" } };
 257 }
 258
 259 =head2 purge_sisters
 260
 261  Usage   : $obj->purge_sister();
 262  Function: Deletes  the list of sisters associated with this term.
 263  Returns : A list of scalars.
 264  Args    :
 265
 266 =cut
 267
 268 sub purge_sisters {
 269     my ( $self ) = @_;
 270     $self->{'_sisters'} = [];
 271 }
 272
 273 1;