| 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 |