File Coverage

blib/lib/Array/Heap/ModifiablePriorityQueue.pm
Criterion Covered Total %
statement 71 71 100.0
branch 16 18 88.8
condition n/a
subroutine 17 17 100.0
pod 13 13 100.0
total 117 119 98.3


line stmt bran cond sub pod time code
1             package Array::Heap::ModifiablePriorityQueue;
2 1     1   18029 use strict;
  1         2  
  1         41  
3 1     1   7 use warnings;
  1         2  
  1         35  
4 1     1   3 use vars qw( $VERSION );
  1         4  
  1         69  
5             $VERSION = '1.10';
6 1         804 use Array::Heap qw( adjust_heap_idx make_heap_idx pop_heap_idx push_heap_idx
7 1     1   532 splice_heap_idx );
  1         593  
8              
9             =head1 NAME
10              
11             Array::Heap::ModifiablePriorityQueue - Modifiable priority queue
12              
13             =head1 SYNOPSIS
14              
15             use Array::Heap::ModifiablePriorityQueue;
16             my $pq = Array::Heap::ModifiablePriorityQueue->new();
17             $pq->add('fish', 42);
18             $pq->add('banana', 27);
19             print $pq->peek(), "\n"; # banana
20             $pq->remove('banana');
21             print $pq->get(), "\n"; # fish
22              
23             =head1 DESCRIPTION
24              
25             This module implements a priority queue, which is a data structure that can
26             efficiently locate the item with the lowest weight at any time. This is useful
27             for writing cost-minimizing and shortest-path algorithms.
28              
29             Why another priority queue module? First, unlike many similar modules, this one
30             allows you to modify the queue. Items can be removed from the queue or have
31             their weight changed after they are added.
32              
33             Second, it simple to use. Items in the queue don't have to implement any
34             specific interface. Just throw them in there along with a weight value and
35             the module will keep track of everything.
36              
37             Finally, it has good performance on large datasets. This is because it is
38             based on a partially-ordered heap data structure. Many other priority
39             queue modules are based on fully sorted lists (even ones that claim to be
40             heaps). Keeping the items only partially sorted saves time when there are
41             are a large number of them (several thousand or so).
42              
43             This module is a Perl wrapper around L, a lightweight and fast
44             heap management module implemented in XS.
45              
46             =head1 FUNCTIONS
47              
48             =over 4
49              
50             =item Array::Heap::ModifiablePriorityQueue->new()
51              
52             Create a new, empty priority queue.
53              
54             =cut
55              
56             sub new {
57 3     3 1 16 my ($class) = @_;
58 3         16 return bless { heap => [], items => {} } => $class;
59             }
60              
61             =item $pq->add($item, $weight)
62              
63             Add an item to the priority queue with the given weight. If the item is
64             already present in the queue, modify its weight. Weight must be numeric.
65              
66             =cut
67              
68             sub add {
69 6     6 1 18 my ($self, $item, $weight) = @_;
70 6 100       12 if (my $node = $self->{items}{$item}) {
71 1         2 $node->[0] = $weight;
72 1         2 adjust_heap_idx @{$self->{heap}}, $node->[1];
  1         7  
73             }
74             else {
75 5         7 $node = [ $weight, 0, $item ];
76 5         7 $self->{items}{$item} = $node;
77 5         4 push_heap_idx @{$self->{heap}}, $node;
  5         23  
78             }
79             }
80              
81             =item $pq->peek()
82              
83             Return the first (numerically lowest weight) item from the queue.
84             Does not modify the queue. Returns undef if the queue is empty.
85              
86             =cut
87              
88             sub peek {
89 1     1 1 3 my ($self) = @_;
90 1 50       5 my $node = $self->{heap}[0] or return;
91 1         3 return $node->[2];
92             }
93              
94             =item $pq->get()
95              
96             Removes the first item from the priority queue and returns it.
97             Returns undef if the queue is empty. If two items in the queue
98             have equal weight, this module makes no guarantee as to which
99             one will be returned first.
100              
101             =cut
102              
103             sub get {
104 4     4 1 6 my ($self) = @_;
105 4 100       7 my $node = pop_heap_idx @{$self->{heap}} or return;
  4         21  
106 3         3 my $item = $node->[2];
107 3         6 delete $self->{items}{$item};
108 3         11 return $item;
109             }
110              
111             =item $pq->remove($item)
112              
113             Removes the given item from the priority queue. If item is not present
114             in the queue, does nothing.
115              
116             =cut
117              
118             sub remove {
119 2     2 1 4 my ($self, $item) = @_;
120 2 100       7 my $node = delete $self->{items}{$item} or return;
121 1         2 splice_heap_idx @{$self->{heap}}, $node->[1];
  1         6  
122             }
123              
124             =item $pq->weight($item)
125              
126             Returns the weight of the item, or undef if it is not present.
127              
128             =cut
129              
130             sub weight {
131 3     3 1 5 my ($self, $item) = @_;
132 3 100       12 my $node = $self->{items}{$item} or return;
133 2         8 return $node->[0];
134             }
135              
136             =item $pq->min_weight($item)
137              
138             Returns the minimum weight from the queue, or undef if empty.
139              
140             =cut
141              
142             sub min_weight {
143 1     1 1 2 my ($self) = @_;
144 1 50       4 my $node = $self->{heap}[0] or return;
145 1         4 return $node->[0];
146             }
147              
148             =item $pq->size()
149              
150             Returns the number of items in the priority queue.
151              
152             =cut
153              
154             sub size {
155 12     12 1 411 my ($self) = @_;
156 12         10 return scalar @{$self->{heap}};
  12         48  
157             }
158              
159             =item $pq->items()
160              
161             Returns all items in the heap, in an arbitrary order.
162              
163             =cut
164              
165             sub items {
166 1     1 1 5 my ($self) = @_;
167 1         2 return map { $_->[2] } @{$self->{heap}};
  3         14  
  1         2  
168             }
169              
170             =item $pq->sorted_items()
171              
172             Returns all items in the heap, in weight order.
173              
174             =cut
175              
176             sub sorted_items {
177 1     1 1 2 my ($self) = @_;
178 1         1 return map { $_->[2] } sort { $a->[0] <=> $b->[0] } @{$self->{heap}};
  3         10  
  3         41  
  1         6  
179             }
180              
181             =item $pq->add_unordered($item, $weight)
182              
183             Add an item to the priority queue or change its weight, without updating
184             the heap structure. If you are adding a bunch of items at once, it may be
185             more efficient to use add_unordered, then call $pq->restore_order() once
186             you are done.
187              
188             =cut
189              
190             sub add_unordered {
191 5     5 1 23 my ($self, $item, $weight) = @_;
192 5 100       9 if (my $node = $self->{items}{$item}) {
193 1         3 $node->[0] = $weight;
194             }
195             else {
196 4         5 my $heap = $self->{heap};
197 4         5 $node = [ $weight, scalar(@$heap), $item ];
198 4         6 $self->{items}{$item} = $node;
199 4         20 push @$heap, $node;
200             }
201             }
202              
203             =item $pq->remove_unordered($item)
204              
205             Remove an item from the priority queue without updating the heap structure.
206             If item is not present in the queue, do nothing.
207              
208             =cut
209              
210             sub remove_unordered {
211 3     3 1 5 my ($self, $item) = @_;
212 3 100       10 my $node = delete $self->{items}{$item} or return;
213 2         3 my $heap = $self->{heap};
214 2         3 my $last = pop @$heap;
215 2 100       7 if ($last != $node) {
216 1         2 $heap->[$node->[1]] = $last;
217 1         2 $last->[1] = $node->[1];
218             }
219             }
220              
221             =item $pq->restore_order()
222              
223             Restore the heap structure after calling add_unordered or remove_unordered.
224             You need to do this before calling any of the ordered methods (add, remove,
225             peek, or get).
226              
227             =cut
228              
229             sub restore_order {
230 1     1 1 2 my ($self) = @_;
231 1         2 make_heap_idx @{$self->{heap}};
  1         5  
232             }
233              
234             =back
235              
236             =head1 PERFORMANCE
237              
238             The peek and weight functions run in constant time, or O(1) in asymptotic
239             notation. The structure-modifying functions add, get, and remove run in
240             O(log n) time. The items function is O(n), and sorted_items is O(n log n).
241             Add_unordered and remove_unordered are O(1), but after a sequence of
242             unordered operations, you need to call restore_order, which is O(n).
243              
244             If you don't need the modifiable features of this module, consider using
245             L instead.
246              
247             If you feel that you need maximum speed, go ahead and inline these
248             methods into your own code to avoid an extra method invocation. They
249             are all quite short and simple.
250              
251             =head1 LIMITATIONS
252              
253             Weight values must be numeric. This is a limitation of the underlying
254             Array::Heap module.
255              
256             Weights are sorted in increasing order only. If you want it the other way,
257             use the negative of the weights you have.
258              
259             Items are distinguished by their stringified values. This works fine if you
260             are storing scalars or plain references. If your items have a custom
261             stringifier that returns nonunique strings, or their stringified value can
262             change, you may need to use Array::Heap directly.
263              
264             =head1 SEE ALSO
265              
266             L for a different priority queue implementation.
267              
268             L is easy to use, but doesn't allow weights to be changed.
269              
270             L if you need more direct access to the data structure.
271              
272             =head1 AUTHOR
273              
274             Bob Mathews
275              
276             =head1 REPOSITORY
277              
278             L
279              
280             =head1 COPYRIGHT
281              
282             This program is free software; you can redistribute
283             it and/or modify it under the same terms as Perl itself.
284              
285             The full text of the license can be found in the
286             LICENSE file included with this module.
287              
288             =cut
289              
290             1 # end ModifiablePriorityQueue.pm