Permalink
Browse files

merge in trunk changes

svn path=/bioperl-dev/branches/nexml-arbgeno/; revision=15985
  • Loading branch information...
maj
maj committed Aug 18, 2009
1 parent c40174c commit f9386167ea66fa428dabc61566bd734649aa41aa
Showing with 72 additions and 28 deletions.
  1. +2 −2 Bio/AlignIO/nexml.pm
  2. +15 −14 Bio/Nexml/Factory.pm
  3. +0 −1 Bio/NexmlIO.pm
  4. +1 −1 Bio/PopGen/IO/nexml.pm
  5. +1 −2 Bio/SeqIO/nexml.pm
  6. +2 −1 Bio/TreeIO/nexml.pm
  7. +45 −0 t/PopGenIO/nexml.t
  8. +6 −7 t/nexml.t
View
@@ -64,10 +64,10 @@ package Bio::AlignIO::nexml;
use strict;
use lib '../..';
-use Bio::Phylo::IO qw(parse unparse);
-use Bio::Phylo::Matrices;
use Bio::LocatableSeq;
use Bio::Nexml::Factory;
+use Bio::Phylo::IO qw(parse unparse);
+
use base qw(Bio::AlignIO);
View
@@ -80,21 +80,20 @@ package Bio::Nexml::Factory;
use strict;
-# check for Bio::Phylo
BEGIN {
use Bio::Root::Root;
unless (eval "require Bio::Phylo; 1") {
- Bio::Root::Root->throw("NeXML support requires the Bio::Phylo package to be installed. You can find out how to obtain Bio::Phylo at http://www.nexml.org.");
+ Bio::Root::Root->throw("Bio::Phylo package required; see http://www.nexml.org for download details");
}
}
-
-# isolate all Bio::Phylo includes here in Factory
-use Bio::Phylo::IO qw(parse unparse);
+
use Bio::Phylo::Factory;
use Bio::Phylo::Matrices;
use Bio::Phylo::Matrices::Matrix;
use Bio::Phylo::Matrices::Datum;
use Bio::Phylo::Forest::Tree;
+use Bio::Phylo::Matrices;
+use Bio::Phylo::IO;
use Bio::SeqFeature::Generic;
use Bio::PopGen::Population;
@@ -708,6 +707,7 @@ sub create_bphylo_popn {
my $allele_tbl;
if ( $type eq 'standard' ) {
## need to make two-d: chars X states = markers X alleles ##
+ $DB::single=1;
my (%a,@st);
# want to get alleles from markers not individs
for my $mrk (sort $popn->get_marker_names) {
@@ -722,8 +722,8 @@ sub create_bphylo_popn {
for my $i ( @inds ) {
#create data linked to taxa
- my @data = $self->create_bphylo_datum($i, $taxa, '-alleles'=>$allele_tbl,'-type_object' => $to);
- $matrix->insert(@data);
+ my $datum = $self->create_bphylo_datum($i, $taxa, '-alleles'=>$allele_tbl,'-type_object' => $to);
+ $matrix->insert($datum);
}
return $matrix;
}
@@ -965,16 +965,17 @@ sub create_bphylo_datum {
# following code writes only markers with data present for
# the individual -- does Bio::Phylo take care of the missing
# data, or is that our responsibility?/maj
+ $datum = $class->new(@args);
foreach my $mrk (sort $obj->get_marker_names) {
- $datum = $class->new(@args);
- $datum->set_name( $name ) if defined $name;
- $datum->set_taxon($taxa->get_by_name($taxon_name));
+ my $d = $class->new(@args);
+ $d->set_name( $mrk);
+ $d->set_taxon($taxa->get_by_name($taxon_name));
my @a = map { $alleles ? $$alleles{$mrk}{$_} : $_ } $obj->get_Genotypes(-marker=>$mrk)->get_Alleles;
- $datum->set_char(@a);
- $datum->set_desc( $mrk ); # marker name
- push @data, $datum;
+ $d->set_char(@a);
+ $d->set_desc( $obj->{_population} ? $obj->{_population}->get_Marker($mrk)->description : $mrk );
+ $datum->concat($d);
}
- return @data;
+ return $datum;
};
}
View
@@ -370,7 +370,6 @@ sub write {
($taxa_o) = $nexml_fac->create_bphylo_taxa($seq);
$taxa_hash{$seq->{_Nexml_ID}} = $taxa_o;
}
- $DB::single=1;
$datum = $nexml_fac->create_bphylo_seq($seq, $taxa_o);
#check if this Bio::Phylo::Matrices::Matrix obj has already been created
if (defined $seq_matrices{ $seq->{_Nexml_matrix_ID} }) {
View
@@ -220,9 +220,9 @@ sub write_population{
$_->annotation($ac);
for my $i ($_->get_Individuals) {
$i->annotation || $i->annotation(Bio::Annotation::Collection->new());
+ $i->{_population} = $_; # kludge to access marker descriptions later
}
}
-# my $type = ($_->annotation->get_Annotations('datatype'))[0]->value;
my $taxa = $fac->create_bphylo_taxa($_);
my $matrix = $fac->create_bphylo_popn($_, $taxa);
$matrix->set_taxa($taxa);
View
@@ -78,11 +78,10 @@ package Bio::SeqIO::nexml;
use strict;
use lib '../..';
-use Bio::Phylo::Matrices::Datum;
-use Bio::Phylo::IO qw (parse unparse);
use Bio::Seq;
use Bio::Seq::SeqFactory;
use Bio::Nexml::Factory;
+use Bio::Phylo::IO qw (parse unparse);
use base qw(Bio::SeqIO);
View
@@ -76,8 +76,9 @@ use strict;
use lib '../..';
use Bio::Event::EventGeneratorI;
use IO::String;
-use Bio::Phylo::IO qw (parse unparse);
use Bio::Nexml::Factory;
+use Bio::Phylo::IO qw (parse unparse);
+
use base qw(Bio::TreeIO);
View
@@ -0,0 +1,45 @@
+#-*-perl-*-
+# $Id$
+use strict;
+
+#chdir('../..'); # hack to allow run from t
+use lib 't/lib';
+use lib '../..';
+use Bio::Root::Test;
+test_begin( -tests => 1000 );
+use_ok('Bio::PopGen::IO');
+use_ok('Bio::PopGen::IO::nexml');
+use_ok('Bio::Annotation::Collection');
+
+# read
+# ok( my $nexmlio = Bio::PopGen::IO(-format=>'nexml', -file=>test_input_file('01_basic.xml')) );
+ok my $nexmlio = Bio::PopGen::IO->new(-format=>'nexml', -file=>'../data/01_basic.xml') ;
+warning_like { $nexmlio->next_individual } qr/nexml/i ;
+warning_like { $nexmlio->write_individual } qr/nexml/i ;
+warning_like { $nexmlio->write_population } qr/not open/i;
+ok my $popn = $nexmlio->next_population;
+
+my @inds = $popn->get_Individuals;
+is_deeply( [map { ($_->get_Genotypes(-marker => 'c1'))[0]->get_Alleles } @inds],
+ [0, 2, 2, 0, 1, 0] );
+
+# write
+
+ok my $csvio = Bio::PopGen::IO->new(-format=>'csv',-fh=>\*DATA);
+ok $popn = $csvio->next_population;
+my $tf = test_output_file;
+ok $nexmlio = Bio::PopGen::IO->new(-format=>'nexml',-file=>">$tf");
+
+warning_like { $nexmlio->next_population } qr/not open/;
+
+$nexmlio->write_population($popn);
+
+1;
+
+__DATA__
+Species,locA,locB,locC,locD
+Biggus dicus, A a, B B, C c, d d
+Terra parvum, A A, b b, c c, D D
+Acidophilus rex, a a, b b, c c, D d
+Tempus fugit, a a, B b, C C, D d
+Pax romanum, A a, b b, C c, d d
View
@@ -3,12 +3,11 @@
use strict;
-chdir('..'); # hack to allow run from t
-use lib ('..');
use Bio::Root::Test;
use Bio::Tree::Tree;
use Bio::TreeIO;
-test_begin( -tests=>125 );
+test_begin( -tests=>125,
+ -requires_modules => [qw(Bio::Phylo)]);
use_ok('Bio::NexmlIO');
@@ -53,14 +52,14 @@ my $in_nexmlIO = Bio::NexmlIO->new(-file => test_input_file('characters+trees.ne
ok( my $seq1 = $in_nexmlIO->next_seq() );
isa_ok($seq1, 'Bio::Seq');
is( $seq1->alphabet, 'dna', "alphabet" );
- is( $seq1->primary_id, 'DNA sequences.seq_1', "primary_id");
+ is( $seq1->primary_id, 'dna_seq_1', "primary_id");
is( $seq1->display_id, 'dna_seq_1', "display_id");
is( $seq1->seq, 'ACGCTCGCATCGCATC', "sequence");
#checking second sequence object
ok( my $seq2 = $in_nexmlIO->next_seq() );
is( $seq2->alphabet, 'dna', "alphabet" );
- is( $seq2->primary_id, 'DNA sequences.seq_2', "primary_id");
+ is( $seq2->primary_id, 'dna_seq_2', "primary_id");
is( $seq2->display_id, 'dna_seq_2', "display_id");
is( $seq2->seq, 'ACGCTCGCATCGCATT', "sequence");
ok( my $seq3 = $in_nexmlIO->next_seq() );
@@ -158,14 +157,14 @@ my $in_nexmlIO_roundtrip = Bio::NexmlIO->new(-file => $outdata);
ok( my $seq5 = $in_nexmlIO_roundtrip->next_seq() );
isa_ok($seq5, 'Bio::Seq');
is( $seq5->alphabet, 'dna', "alphabet" );
- is( $seq5->primary_id, 'DNA sequences.seq_1', "primary_id");
+ is( $seq5->primary_id, 'dna_seq_1', "primary_id");
is( $seq5->display_id, 'dna_seq_1', "display_id");
is( $seq5->seq, 'ACGCTCGCATCGCATC', "sequence");
#checking second sequence object
ok( my $seq6 = $in_nexmlIO_roundtrip->next_seq() );
is( $seq6->alphabet, 'dna', "alphabet" );
- is( $seq6->primary_id, 'DNA sequences.seq_2', "primary_id");
+ is( $seq6->primary_id, 'dna_seq_2', "primary_id");
is( $seq6->display_id, 'dna_seq_2', "display_id");
is( $seq6->seq, 'ACGCTCGCATCGCATT', "sequence");
#check extract_seqs method

0 comments on commit f938616

Please sign in to comment.