view release on metacpan or  search on metacpan

lib/Bio/Phylo/Matrices/MatrixRole.pm  view on Meta::CPAN

                      defines datatype, one of dna|rna|protein|
                      continuous|standard|restriction|[ mixed => [] ]

           -taxa   => optional, link to taxa object
           -lookup => character state lookup hash ref
           -labels => array ref of character labels
           -matrix => two-dimensional array, first element of every
                      row is label, subsequent are characters

=cut

    sub new : Constructor {

        # could be child class
        my $class = shift;

        # notify user
        $logger->info("constructor called for '$class'");
        if ( not $LOADED_WRAPPERS ) {
            eval do { local $/; <DATA> };
            die $@ if $@;
            $LOADED_WRAPPERS++;
        }

        # go up inheritance tree, eventually get an ID
        my $self = $class->SUPER::new(
            '-characters' => $factory->create_characters,
            '-listener'   => \&_update_characters,
            @_
        );
        return $self;
    }

=item new_from_bioperl()

Matrix constructor from Bio::Align::AlignI argument.

 Type    : Constructor
 Title   : new_from_bioperl
 Usage   : my $matrix =
           Bio::Phylo::Matrices::Matrix->new_from_bioperl(
               $aln
           );
 Function: Instantiates a
           Bio::Phylo::Matrices::Matrix object.
 Returns : A Bio::Phylo::Matrices::Matrix object.
 Args    : An alignment that implements Bio::Align::AlignI

=cut

    sub new_from_bioperl {
        my ( $class, $aln, @args ) = @_;
        if ( looks_like_instance( $aln, 'Bio::Align::AlignI' ) ) {
            $aln->unmatch;
            $aln->map_chars( '\.', '-' );
            my @seqs = $aln->each_seq;
            my ( $type, $missing, $gap, $matchchar );
            if ( $seqs[0] ) {
                $type =
                     $seqs[0]->alphabet
                  || $seqs[0]->_guess_alphabet
                  || 'dna';
            }
            else {
                $type = 'dna';
            }
            my $self = $factory->create_matrix(
                '-type'            => $type,
                '-special_symbols' => {
                    '-missing'   => $aln->missing_char || '?',
                    '-matchchar' => $aln->match_char   || '.',
                    '-gap'       => $aln->gap_char     || '-',
                },
                @args
            );

			# XXX create raw getter/setter pairs for annotation,
			# accession, consensus_meta source
            for my $field ( qw(description accession id annotation consensus_meta score source) ) {
                $self->$field( $aln->$field );
            }
            my $to = $self->get_type_object;
            for my $seq (@seqs) {
                my $datum = Bio::Phylo::Matrices::Datum->new_from_bioperl( $seq,
                    '-type_object' => $to );
                $self->insert($datum);
            }
            return $self;
        }
        else {
            throw 'ObjectMismatch' => 'Not a bioperl alignment!';
        }
    }

=back

=head2 MUTATORS

=over

=item set_special_symbols

Sets three special symbols in one call

 Type    : Mutator
 Title   : set_special_symbols
 Usage   : $matrix->set_special_symbols(
 		       -missing   => '?',
 		       -gap       => '-',
 		       -matchchar => '.'
 		   );
 Function: Assigns state labels.
 Returns : $self
 Args    : Three args (with distinct $x, $y and $z):
  		       -missing   => $x,
 		       -gap       => $y,
 		       -matchchar => $z
 Notes   : This method is here to ensure
           you don't accidentally use the
           same symbol for missing AND gap