# File: PriorityQueue.pm # # Purpose: Bare-bones lightweight implementation of a priority queue. # SPDX-FileCopyrightText: 2021 Pragmatic Software # 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;