~ubuntu-branches/ubuntu/precise/bioperl/precise

#/maj is($node_cnt_orig, scalar($tree->get_nodes), 'Check to see that node count is correct after an internal node was removed after this re-rooting');

180

# but we did add a new node at line 166, so

181

is($node_cnt_orig+1, scalar($tree->get_nodes), 'Node count correct');

165

182

warn("orig total len ", $total_length_orig, "\n") if $verbose;

166

183

warn("new total len ", $tree->total_branch_length,"\n") if $verbose;

167

184

cmp_ok($total_length_orig, '>=', $tree->total_branch_length - $eps,

168

185

'Total original branch length is what it is supposed to be');

186

# branch length should also be invariant w/r to rerooting...

169

187

cmp_ok($total_length_orig, '<=',$tree->total_branch_length + $eps,

170

188

'Updated total branch length after the reroot');

171

is($tree->get_root_node, $a->ancestor, 'Make sure root is really what we asked for');

189

# again, we rerooted ON THE NODE, so $a IS the root./maj

190

is($tree->get_root_node, $a, 'Make sure root is really what we asked for');

172

191

173

# try to reroot on existing root: should fail

174

$a = $tree->get_root_node;

192

# try to reroot on new root: should fail

193

#/maj $a = $tree->get_root_node;

175

194

isnt( $tree->reroot($a),1, 'Testing for failed re-rerooting');

176

195

177

196

# try a more realistic tree

180

199

$node_cnt_orig = scalar($tree->get_nodes);

181

200

$total_length_orig = $tree->total_branch_length;

182

201

$out->write_tree($tree) if $verbose;

183

is($tree->reroot($a->ancestor),1, 'Test that rooting succeeded');

202

is($tree->reroot($a),1, 'Test that rooting succeeded'); #mod /maj

184

203

$out->write_tree($tree) if $verbose;

185

is($node_cnt_orig+1, scalar($tree->get_nodes), 'Test that re-rooted tree has proper number of nodes after re-rooting');

204

# node number should be invariant after reroot/maj

205

is($node_cnt_orig, scalar($tree->get_nodes), 'Test that re-rooted tree has proper number of nodes after re-rooting'); #mod /maj

186

206

$total_length_new = $tree->total_branch_length;

187

207

$eps = 0.001 * $total_length_new; # tolerance for checking length

188

208

cmp_ok($total_length_orig, '>=', $tree->total_branch_length - $eps, 'Branch length before rerooting');

189

209

cmp_ok($total_length_orig, '<=', $tree->total_branch_length + $eps,

190

210

'Branch length after rerooting');

191

is($tree->get_root_node, $a->ancestor->ancestor,'Root is really the ancestor we asked for');

211

is($tree->get_root_node, $a,'Root is really the ancestor we asked for'); #mod /maj

192

212

193

213

# BFS and DFS search testing

194

214

$treeio = Bio::TreeIO->new(-verbose => $verbose,

224

244

is($DFSorder, '0,1,2,A,B,C,D,3,E,F', 'DFS traversal after removing G');

225

245

$tree->splice(-remove_id => [('E', 'F')], -keep_id => 'F');

226

246

$DFSorder = join(",", map { $_->id } ( $tree->get_nodes(-order => 'd')));

227

is($DFSorder, '0,1,2,A,B,C,D,F', 'DFS traversal after removing F');

247

# the node '3' is not explicitly removed, so it should still be there

248

# I suspect that it disappeared before was due to the previously

249

# automatic removal of internal degree 2 nodes../maj

250

is($DFSorder, '0,1,2,A,B,C,D,3,F', 'DFS traversal after removing E');

228

251

$tree->splice(-keep_id => [qw(0 1 2 A B C D)]);

229

252

$DFSorder = join(",", map { $_->id } ( $tree->get_nodes(-order => 'd')));

230

253

is($DFSorder, '0,1,2,A,B,C,D', 'DFS after removing all but 0,1,2,A,B,C,D');

262

285

263

286

__DATA__

264

287

(D,(C,(A,B)));

265

(I,((D,(C,(A,B))),(E,(F,G))));

288

(I,((D,(C,(A,B)x)y),(E,(F,G))));

266

289

(((A:0.3,B:2.1):0.45,C:0.7),D:4);

267

290

(A:0.031162,((((((B:0.022910,C:0.002796):0.010713,(D:0.015277,E:0.020484):0.005336):0.005588,((F:0.013293,(G:0.018374,H:0.003108):0.005318):0.006047,I:0.014607):0.001677):0.004196,(((((J:0.003307,K:0.001523):0.011884,L:0.006960):0.006514,((M:0.001683,N:0.000100):0.002226,O:0.007085):0.014649):0.008004,P:0.037422):0.005201,(Q:0.000805,R:0.000100):0.015280):0.005736):0.004612,S:0.042283):0.017979,(T:0.006883,U:0.016655):0.040226):0.014239,((((((V:0.000726,W:0.000100):0.028490,((((X:0.011182,Y:0.001407):0.005293,Z:0.011175):0.004701,AA:0.007825):0.016256,BB:0.029618):0.008146):0.004279,CC:0.035012):0.060215,((((((DD:0.014933,(EE:0.008148,FF:0.000100):0.015458):0.003891,GG:0.010996):0.001489,(HH:0.000100,II:0.000100):0.054265):0.003253,JJ:0.019722):0.013796,((KK:0.001960,LL:0.004924):0.013034,MM:0.010071):0.043273):0.011912,(NN:0.031543,OO:0.018307):0.059182):0.026517):0.011087,((PP:0.000100,QQ:0.002916):0.067214,(RR:0.064486,SS:0.013444):0.011613):0.050846):0.015644,((TT:0.000100,UU:0.009287):0.072710,(VV:0.009242,WW:0.009690):0.035346):0.042993):0.060365);

Older »