Filename | /Users/ap13/perl5/lib/perl5/Graph/BitMatrix.pm |
Statements | Executed 3 statements in 892µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 11µs | 22µs | BEGIN@3 | Graph::BitMatrix::
0 | 0 | 0 | 0s | 0s | get | Graph::BitMatrix::
0 | 0 | 0 | 0s | 0s | get_row | Graph::BitMatrix::
0 | 0 | 0 | 0s | 0s | new | Graph::BitMatrix::
0 | 0 | 0 | 0s | 0s | set | Graph::BitMatrix::
0 | 0 | 0 | 0s | 0s | set_row | Graph::BitMatrix::
0 | 0 | 0 | 0s | 0s | unset | Graph::BitMatrix::
0 | 0 | 0 | 0s | 0s | unset_row | Graph::BitMatrix::
0 | 0 | 0 | 0s | 0s | vertices | Graph::BitMatrix::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Graph::BitMatrix; | ||||
2 | |||||
3 | 2 | 888µs | 2 | 33µs | # spent 22µs (11+11) within Graph::BitMatrix::BEGIN@3 which was called:
# once (11µs+11µs) by Graph::AdjacencyMatrix::BEGIN@5 at line 3 # spent 22µs making 1 call to Graph::BitMatrix::BEGIN@3
# spent 11µs making 1 call to strict::import |
4 | |||||
5 | # $SIG{__DIE__ } = sub { use Carp; confess }; | ||||
6 | # $SIG{__WARN__} = sub { use Carp; confess }; | ||||
7 | |||||
8 | sub _V () { 2 } # Graph::_V() | ||||
9 | sub _E () { 3 } # Graph::_E() | ||||
10 | sub _i () { 3 } # Index to path. | ||||
11 | sub _s () { 4 } # Successors / Path to Index. | ||||
12 | |||||
13 | sub new { | ||||
14 | my ($class, $g, %opt) = @_; | ||||
15 | my @V = $g->vertices; | ||||
16 | my $V = @V; | ||||
17 | my $Z = "\0" x (($V + 7) / 8); | ||||
18 | my %V; @V{ @V } = 0 .. $#V; | ||||
19 | my $bm = bless [ [ ( $Z ) x $V ], \%V ], $class; | ||||
20 | my $bm0 = $bm->[0]; | ||||
21 | my $connect_edges; | ||||
22 | if (exists $opt{connect_edges}) { | ||||
23 | $connect_edges = $opt{connect_edges}; | ||||
24 | delete $opt{connect_edges}; | ||||
25 | } | ||||
26 | $connect_edges = 1 unless defined $connect_edges; | ||||
27 | Graph::_opt_unknown(\%opt); | ||||
28 | if ($connect_edges) { | ||||
29 | # for (my $i = 0; $i <= $#V; $i++) { | ||||
30 | # my $u = $V[$i]; | ||||
31 | # for (my $j = 0; $j <= $#V; $j++) { | ||||
32 | # vec($bm0->[$i], $j, 1) = 1 if $g->has_edge($u, $V[$j]); | ||||
33 | # } | ||||
34 | # } | ||||
35 | my $Vi = $g->[_V]->[_i]; | ||||
36 | my $Ei = $g->[_E]->[_i]; | ||||
37 | if ($g->is_undirected) { | ||||
38 | for my $e (keys %{ $Ei }) { | ||||
39 | my ($i0, $j0) = @{ $Ei->{ $e } }; | ||||
40 | my $i1 = $V{ $Vi->{ $i0 } }; | ||||
41 | my $j1 = $V{ $Vi->{ $j0 } }; | ||||
42 | vec($bm0->[$i1], $j1, 1) = 1; | ||||
43 | vec($bm0->[$j1], $i1, 1) = 1; | ||||
44 | } | ||||
45 | } else { | ||||
46 | for my $e (keys %{ $Ei }) { | ||||
47 | my ($i0, $j0) = @{ $Ei->{ $e } }; | ||||
48 | vec($bm0->[$V{ $Vi->{ $i0 } }], $V{ $Vi->{ $j0 } }, 1) = 1; | ||||
49 | } | ||||
50 | } | ||||
51 | } | ||||
52 | return $bm; | ||||
53 | } | ||||
54 | |||||
55 | sub set { | ||||
56 | my ($m, $u, $v) = @_; | ||||
57 | my ($i, $j) = map { $m->[1]->{ $_ } } ($u, $v); | ||||
58 | vec($m->[0]->[$i], $j, 1) = 1 if defined $i && defined $j; | ||||
59 | } | ||||
60 | |||||
61 | sub unset { | ||||
62 | my ($m, $u, $v) = @_; | ||||
63 | my ($i, $j) = map { $m->[1]->{ $_ } } ($u, $v); | ||||
64 | vec($m->[0]->[$i], $j, 1) = 0 if defined $i && defined $j; | ||||
65 | } | ||||
66 | |||||
67 | sub get { | ||||
68 | my ($m, $u, $v) = @_; | ||||
69 | my ($i, $j) = map { $m->[1]->{ $_ } } ($u, $v); | ||||
70 | defined $i && defined $j ? vec($m->[0]->[$i], $j, 1) : undef; | ||||
71 | } | ||||
72 | |||||
73 | sub set_row { | ||||
74 | my ($m, $u) = splice @_, 0, 2; | ||||
75 | my $m0 = $m->[0]; | ||||
76 | my $m1 = $m->[1]; | ||||
77 | my $i = $m1->{ $u }; | ||||
78 | return unless defined $i; | ||||
79 | for my $v (@_) { | ||||
80 | my $j = $m1->{ $v }; | ||||
81 | vec($m0->[$i], $j, 1) = 1 if defined $j; | ||||
82 | } | ||||
83 | } | ||||
84 | |||||
85 | sub unset_row { | ||||
86 | my ($m, $u) = splice @_, 0, 2; | ||||
87 | my $m0 = $m->[0]; | ||||
88 | my $m1 = $m->[1]; | ||||
89 | my $i = $m1->{ $u }; | ||||
90 | return unless defined $i; | ||||
91 | for my $v (@_) { | ||||
92 | my $j = $m1->{ $v }; | ||||
93 | vec($m0->[$i], $j, 1) = 0 if defined $j; | ||||
94 | } | ||||
95 | } | ||||
96 | |||||
97 | sub get_row { | ||||
98 | my ($m, $u) = splice @_, 0, 2; | ||||
99 | my $m0 = $m->[0]; | ||||
100 | my $m1 = $m->[1]; | ||||
101 | my $i = $m1->{ $u }; | ||||
102 | return () x @_ unless defined $i; | ||||
103 | my @r; | ||||
104 | for my $v (@_) { | ||||
105 | my $j = $m1->{ $v }; | ||||
106 | push @r, defined $j ? (vec($m0->[$i], $j, 1) ? 1 : 0) : undef; | ||||
107 | } | ||||
108 | return @r; | ||||
109 | } | ||||
110 | |||||
111 | sub vertices { | ||||
112 | my ($m, $u, $v) = @_; | ||||
113 | keys %{ $m->[1] }; | ||||
114 | } | ||||
115 | |||||
116 | 1 | 4µs | 1; | ||
117 | __END__ |