fix subgraph of undirected - fix #28
Ed J
1 year, 2 months ago
1224 | 1224 |
my $v = Set::Object->new($dst ? grep $g->has_vertex($_), @$dst : @u);
|
1225 | 1225 |
$s->add_vertices(@u, $dst ? $v->members : ());
|
1226 | 1226 |
my $directed = &is_directed;
|
1227 | |
$s->add_edges(grep $v->contains($directed ? $_->[1] : @$_), $g->edges_from(@u));
|
|
1227 |
if ($directed) {
|
|
1228 |
$s->add_edges(grep $v->contains($_->[1]), $g->edges_from(@u));
|
|
1229 |
} else {
|
|
1230 |
my $valid = $dst ? $v + Set::Object->new(@u) : $v;
|
|
1231 |
$s->add_edges(
|
|
1232 |
grep +($v->contains($_->[0]) || $v->contains($_->[1])) &&
|
|
1233 |
($valid->contains($_->[0]) && $valid->contains($_->[1])),
|
|
1234 |
$g->edges_from(@u)
|
|
1235 |
);
|
|
1236 |
}
|
1228 | 1237 |
return $s;
|
1229 | 1238 |
}
|
1230 | 1239 |
|
29 | 29 |
my $g1 = Graph::Undirected->new;
|
30 | 30 |
$g1->add_edges(@E);
|
31 | 31 |
|
|
32 |
is $g1->subgraph([qw(a b c)], [qw(d e f)]), "b=d,b=e,c=f,a";
|
|
33 |
is $g1->subgraph([qw(a b c)]), "a=b,a=c";
|
|
34 |
is $g1->subgraph(['a'],['e']), "a,e";
|
|
35 |
|
32 | 36 |
is($g1->subgraph_by_radius('a', 0)->stringify, "a");
|
33 | 37 |
is($g1->subgraph_by_radius('a', 1)->stringify, "a=b,a=c");
|
34 | 38 |
is($g1->subgraph_by_radius('a', 2)->stringify, "a=b,a=c,b=d,b=e,c=f,c=g");
|