1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
Description: fix BitMatrix and AdjacencyMatrix problems
Origin: upstream git, diff 0.9720..0.9721
Bug: https://github.com/graphviz-perl/Graph/issues/20
Bug-Debian: https://bugs.debian.org/987095
Author: Ed J <mohawk2@users.noreply.github.com>
Reviewed-by: gregor herrmann <gregoa@debian.org>
Last-Update: 2021-04-18
--- a/lib/Graph.pm
+++ b/lib/Graph.pm
@@ -356,6 +356,7 @@
sub _vertex_ids_maybe_ensure {
my $ensure = pop;
my ($g, @args) = @_;
+ __carp_confess "Graph: given undefined vertex" if grep !defined, @args;
my $V = $g->[ _V ];
if (($V->[ _f ] & _LIGHT)) {
my $s = $V->[ _s ];
--- a/lib/Graph/AdjacencyMatrix.pm
+++ b/lib/Graph/AdjacencyMatrix.pm
@@ -29,31 +29,22 @@
my $m = Graph::BitMatrix->new($g);
my $self = bless [ $m, undef, \@V ], $class;
return $self if !$want_distance;
- # for my $u (@V) {
- # for my $v (@V) {
- # if ($g->has_edge($u, $v)) {
- # $n->set($u, $v,
- # $g->get_edge_attribute($u, $v, $d));
- # }
- # }
- # }
my $n = $self->[ _DM ] = Graph::Matrix->new($g);
$n->set($_, $_, 0) for @V;
- my $Ei = $g->[_E][_i];
my $n0 = $n->[0];
my $n1 = $n->[1];
my $undirected = $g->is_undirected;
my $multiedged = $g->multiedged;
- for my $t (grep defined, @$Ei) {
- my ($i0, $j0) = @$t;
- my $u = $V[ $i0 ];
- my $v = $V[ $j0 ];
- $n0->[ $i0 ]->[ $j0 ] = $multiedged
+ for my $e ($g->edges) {
+ my ($u, $v) = @$e;
+ $n->set($u, $v, $multiedged
? _multiedged_distances($g, $u, $v, $d)
- : $g->get_edge_attribute($u, $v, $d);
- $n0->[ $j0 ]->[ $i0 ] = $multiedged
+ : $g->get_edge_attribute($u, $v, $d)
+ );
+ $n->set($v, $u, $multiedged
? _multiedged_distances($g, $v, $u, $d)
- : $g->get_edge_attribute($v, $u, $d) if $undirected;
+ : $g->get_edge_attribute($v, $u, $d)
+ ) if $undirected;
}
$self;
}
--- a/lib/Graph/BitMatrix.pm
+++ b/lib/Graph/BitMatrix.pm
@@ -30,19 +30,12 @@
# vec($bm0->[$i], $j, 1) = 1 if $g->has_edge($u, $V[$j]);
# }
# }
- my $Ei = $g->[_E]->[_i];
- if ($g->is_undirected) {
- for my $e (grep defined, @{ $Ei }) {
- my ($i0, $j0) = @$e;
- vec($bm0->[$i0], $j0, 1) = 1;
- vec($bm0->[$j0], $i0, 1) = 1;
- }
- } else {
- for my $e (grep defined, @{ $Ei }) {
- my ($i0, $j0) = @$e;
- ($j0, $i0) = ($i0, $j0) if $transpose;
- vec($bm0->[$i0], $j0, 1) = 1;
- }
+ my $undirected = $g->is_undirected;
+ for my $e ($g->edges) {
+ my ($i0, $j0) = map $V{$_}, @$e;
+ ($j0, $i0) = ($i0, $j0) if $transpose;
+ vec($bm0->[$i0], $j0, 1) = 1;
+ vec($bm0->[$j0], $i0, 1) = 1 if $undirected;
}
$bm;
}
--- a/t/72_transitive.t
+++ b/t/72_transitive.t
@@ -1,5 +1,5 @@
use strict; use warnings;
-use Test::More tests => 235;
+use Test::More tests => 237;
use Graph::Directed;
use Graph::Undirected;
@@ -506,3 +506,14 @@
EOF
ok $tcg->is_reachable(7, 8), '7-8 reachable when on cycle';
}
+
+{
+ my $g = Graph::Directed->new(edges => [
+ [qw(A C)], [qw(A NOTA)], [qw(B A)], [qw(B C)], [qw(B NOTA)],
+ ]);
+ $g->delete_vertex('C');
+ my $tc = $g->transitive_closure;
+ is $tc, 'A-A,A-NOTA,B-A,B-B,B-NOTA,NOTA-NOTA';
+ $tc->delete_edge($_,$_) for qw(A B C N);
+ is $tc, 'A-NOTA,B-A,B-NOTA,NOTA-NOTA';
+}
--- a/t/83_bitmatrix.t
+++ b/t/83_bitmatrix.t
@@ -6,10 +6,12 @@
my $g = Graph->new;
+$g->add_edge(qw(e a));
$g->add_edge(qw(a b));
$g->add_edge(qw(b c));
$g->add_edge(qw(b d));
$g->add_edge(qw(d d));
+$g->delete_vertex('e');
my $m = Graph::BitMatrix->new($g);
|
