mirror of https://github.com/pragma-/pbot.git
116 lines
2.7 KiB
Perl
116 lines
2.7 KiB
Perl
# File: PriorityQueue.pm
|
|
#
|
|
# Purpose: Bare-bones lightweight implementation of a priority queue.
|
|
|
|
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
|
# SPDX-License-Identifier: MIT
|
|
|
|
package PBot::Core::Utils::PriorityQueue;
|
|
|
|
use PBot::Imports;
|
|
|
|
sub new {
|
|
my ($class, %args) = @_;
|
|
|
|
return bless {
|
|
# list of entries; each entry is expected to have a `priority` and an `id` field
|
|
queue => [],
|
|
}, $class;
|
|
}
|
|
|
|
sub queue {
|
|
my ($self) = @_;
|
|
return $self->{queue};
|
|
}
|
|
|
|
sub entries {
|
|
my ($self) = @_;
|
|
return @{$self->{queue}};
|
|
}
|
|
|
|
sub count {
|
|
my ($self) = @_;
|
|
return scalar @{$self->{queue}};
|
|
}
|
|
|
|
sub get {
|
|
my ($self, $position) = @_;
|
|
return $self->{queue}->[$position];
|
|
}
|
|
|
|
sub get_priority {
|
|
my ($self, $position) = @_;
|
|
return $self->{queue}->[$position]->{priority};
|
|
}
|
|
|
|
sub remove {
|
|
my ($self, $position) = @_;
|
|
return splice @{$self->{queue}}, $position, 1;
|
|
}
|
|
|
|
# quickly and efficiently find the best position in the entry
|
|
# queue array for a given priority value
|
|
sub find_enqueue_position {
|
|
my ($self, $priority) = @_;
|
|
|
|
$priority //= 0;
|
|
|
|
# shorter alias
|
|
my $queue = $self->{queue};
|
|
|
|
# no entries in queue yet, early-return first position
|
|
return 0 if not @$queue;
|
|
|
|
# early-return first position if entry's priority is less
|
|
# than first position's
|
|
if ($priority < $queue->[0]->{priority}) {
|
|
return 0;
|
|
}
|
|
|
|
# early-return last position if entry's priority is greater
|
|
if ($priority > $queue->[@$queue - 1]->{priority}) {
|
|
return scalar @$queue;
|
|
}
|
|
|
|
# binary search to find enqueue position
|
|
|
|
my $lo = 0;
|
|
my $hi = scalar @$queue - 1;
|
|
|
|
while ($lo <= $hi) {
|
|
my $mid = int (($hi + $lo) / 2);
|
|
|
|
if ($priority < $queue->[$mid]->{priority}) {
|
|
$hi = $mid - 1;
|
|
} elsif ($priority > $queue->[$mid]->{priority}) {
|
|
$lo = $mid + 1;
|
|
} else {
|
|
# found a slot with the same priority. we "slide" down the array
|
|
# to append this entry to the end of this region of same-priorities
|
|
# and then return the final slot
|
|
while ($mid < @$queue and $queue->[$mid]->{priority} == $priority) {
|
|
$mid++;
|
|
}
|
|
return $mid;
|
|
}
|
|
}
|
|
|
|
return $lo;
|
|
}
|
|
|
|
sub add {
|
|
my ($self, $entry) = @_;
|
|
my $position = $self->find_enqueue_position($entry->{priority});
|
|
splice @{$self->{queue}}, $position, 0, $entry;
|
|
return $position;
|
|
}
|
|
|
|
sub update_priority {
|
|
my ($self, $id, $priority) = @_;
|
|
my @entries = grep { $_->{id} eq $id } @{$self->{queue}};
|
|
map { $_->{priority} = $priority } @entries;
|
|
$self->{queue} = [ sort { $a->{priority} <=> $b->{priority} } @{$self->{queue}} ];
|
|
}
|
|
|
|
1;
|