Codebase list libgraph-perl / 6bdaa17
fix subgraph of undirected - fix #28 Ed J 1 year, 2 months ago
2 changed file(s) with 14 addition(s) and 1 deletion(s). Raw diff Collapse all Expand all
12241224 my $v = Set::Object->new($dst ? grep $g->has_vertex($_), @$dst : @u);
12251225 $s->add_vertices(@u, $dst ? $v->members : ());
12261226 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 }
12281237 return $s;
12291238 }
12301239
2929 my $g1 = Graph::Undirected->new;
3030 $g1->add_edges(@E);
3131
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
3236 is($g1->subgraph_by_radius('a', 0)->stringify, "a");
3337 is($g1->subgraph_by_radius('a', 1)->stringify, "a=b,a=c");
3438 is($g1->subgraph_by_radius('a', 2)->stringify, "a=b,a=c,b=d,b=e,c=f,c=g");