File Coverage

blib/lib/Array/Heap/ModifiablePriorityQueue.pm
Criterion Covered Total %
statement 56 56 100.0
branch 12 14 85.7
condition n/a
subroutine 13 13 100.0
pod 9 9 100.0
total 90 92 97.8


line stmt bran cond sub pod time code
1             package Array::Heap::ModifiablePriorityQueue;
2 1     1   23181 use strict;
  1         3  
  1         58  
3 1     1   7 use warnings;
  1         2  
  1         48  
4 1     1   7 use vars qw( $VERSION );
  1         8  
  1         90  
5             $VERSION = '1.0';
6 1         809 use Array::Heap qw( adjust_heap_idx make_heap_idx pop_heap_idx push_heap_idx
7 1     1   762 splice_heap_idx );
  1         821  
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 2     2 1 15 my ($class) = @_;
58 2         12 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 3     3 1 5 my ($self, $item, $weight) = @_;
70 3 100       15 if (my $node = $self->{items}{$item}) {
71 1         2 $node->[0] = $weight;
72 1         2 adjust_heap_idx @{$self->{heap}}, $node->[1];
  1         6  
73             }
74             else {
75 2         4 $node = [ $weight, 0, $item ];
76 2         6 $self->{items}{$item} = $node;
77 2         2 push_heap_idx @{$self->{heap}}, $node;
  2         16  
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 2 my ($self) = @_;
90 1 50       5 my $node = $self->{heap}[0] or return;
91 1         4 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 3     3 1 7 my ($self) = @_;
105 3 50       4 my $node = pop_heap_idx @{$self->{heap}} or return;
  3         21  
106 3         5 my $item = $node->[2];
107 3         6 delete $self->{items}{$item};
108 3         12 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 3 my ($self, $item) = @_;
120 2 100       9 my $node = delete $self->{items}{$item} or return;
121 1         2 splice_heap_idx @{$self->{heap}}, $node->[1];
  1         5  
122             }
123              
124             =item $pq->size()
125              
126             Returns the number of items in the priority queue.
127              
128             =cut
129              
130             sub size {
131 12     12 1 436 my ($self) = @_;
132 12         10 return scalar @{$self->{heap}};
  12         51  
133             }
134              
135             =item $pq->add_unordered($item, $weight)
136              
137             Add an item to the priority queue or change its weight, without updating
138             the heap structure. If you are adding a bunch of items at once, it may be
139             more efficient to use add_unordered, then call $pq->restore_order() once
140             you are done.
141              
142             =cut
143              
144             sub add_unordered {
145 5     5 1 21 my ($self, $item, $weight) = @_;
146 5 100       11 if (my $node = $self->{items}{$item}) {
147 1         3 $node->[0] = $weight;
148             }
149             else {
150 4         4 my $heap = $self->{heap};
151 4         7 $node = [ $weight, scalar(@$heap), $item ];
152 4         7 $self->{items}{$item} = $node;
153 4         6 push @$heap, $node;
154             }
155             }
156              
157             =item $pq->remove_unordered($item)
158              
159             Remove an item from the priority queue without updating the heap structure.
160             If item is not present in the queue, do nothing.
161              
162             =cut
163              
164             sub remove_unordered {
165 3     3 1 9 my ($self, $item) = @_;
166 3 100       13 my $node = delete $self->{items}{$item} or return;
167 2         3 my $heap = $self->{heap};
168 2         3 my $last = pop @$heap;
169 2 100       22 if ($last != $node) {
170 1         3 $heap->[$node->[1]] = $last;
171 1         3 $last->[1] = $node->[1];
172             }
173             }
174              
175             =item $pq->restore_order()
176              
177             Restore the heap structure after calling add_unordered or remove_unordered.
178             You need to do this before calling any of the ordered methods (add, remove,
179             peek, or get).
180              
181             =cut
182              
183             sub restore_order {
184 1     1 1 2 my ($self) = @_;
185 1         1 make_heap_idx @{$self->{heap}};
  1         8  
186             }
187              
188             =back
189              
190             =head1 PERFORMANCE
191              
192             The peek function runs in constant time, or O(1) in asymptotic notation.
193             The structure-modifying functions add, get, and remove run in O(log n) time.
194             Add_unordered and remove_unordered are O(1), but after a sequence of
195             unordered operations, you need to call restore_order, which is O(n).
196              
197             If you feel that you need maximum speed, go ahead and inline these
198             methods into your own code to avoid an extra method invocation. They
199             are all quite short and simple.
200              
201             =head1 LIMITATIONS
202              
203             =over 4
204              
205             =item *
206              
207             Weight values must be numeric. This is a limitation of the underlying
208             Array::Heap module.
209              
210             =item *
211              
212             Weights are sorted in increasing order only. If you want it the other way,
213             use the negative of the weights you have.
214              
215             =item *
216              
217             Items are distinguished by their stringified values. This works fine if you
218             are storing scalars or plain references. If your items have a custom
219             stringifier that returns nonunique strings, or their stringified value can
220             change, you may need to use Array::Heap directly.
221              
222             =back
223              
224             =head1 AUTHOR
225              
226             Bob Mathews
227              
228             =head1 COPYRIGHT
229              
230             This program is free software; you can redistribute
231             it and/or modify it under the same terms as Perl itself.
232              
233             The full text of the license can be found in the
234             LICENSE file included with this module.
235              
236             =cut
237              
238             1 # end ModifiablePriorityQueue.pm