R/priorityqueue.R

In tomkuipers1402/shiny: Web Application Framework for R

# "...like a regular queue or stack data structure, but where additionally each
# element has a "priority" associated with it. In a priority queue, an element
# with high priority is served before an element with low priority. If two
# elements have the same priority, they are served according to their order in
# the queue." (http://en.wikipedia.org/wiki/Priority_queue)

PriorityQueue <- R6Class(
  'PriorityQueue',
  portable = FALSE,
  class = FALSE,
  public = list(
    # Keys are priorities, values are subqueues (implemented as list)
    .itemsByPriority = 'Map',
    # Sorted vector (largest first)
    .priorities = numeric(0),

    initialize = function() {
      .itemsByPriority <<- Map$new()
    },
    # Enqueue an item, with the given priority level (must be integer). Higher
    # priority numbers are dequeued earlier than lower.
    enqueue = function(item, priority) {
      priority <- normalizePriority(priority)

      if (!(priority %in% .priorities)) {
        .priorities <<- c(.priorities, priority)
        .priorities <<- sort(.priorities, decreasing=TRUE)
        .itemsByPriority$set(.key(priority), list(item))
      } else {
        .itemsByPriority$set(
          .key(priority),
          c(.itemsByPriority$get(.key(priority)), item)
        )
      }
      return(invisible())
    },
    # Retrieve a single item by 1) priority number (highest first) and then 2)
    # insertion order (first in, first out). If there are no items to be
    # dequeued, then NULL is returned. If it is necessary to distinguish between
    # a NULL value and the empty case, call isEmpty() before dequeue().
    dequeue = function() {
      if (length(.priorities) == 0)
        return(NULL)

      maxPriority <- .priorities[[1]]
      items <- .itemsByPriority$get(.key(maxPriority))
      firstItem <- items[[1]]
      if (length(items) == 1) {
        # This is the last item at this priority. Remove both the list and the
        # priority level.
        .itemsByPriority$remove(.key(maxPriority))
        .priorities <<- .priorities[-1]
      } else {
        # There are still items at this priority. Remove the current item from
        # the list, and save it.
        items <- items[-1]
        .itemsByPriority$set(.key(maxPriority), items)
      }
      return(firstItem)
    },
    # Returns TRUE if no items are in the queue, otherwise FALSE.
    isEmpty = function() {
      length(.priorities) == 0
    },
    # Translates a priority integer to a character that is suitable for using as
    # a key.
    .key = function(priority) {
      sprintf('%a', priority)
    }
  )
)

normalizePriority <- function(priority) {

  if (is.null(priority))
    priority <- 0

  # Cast integers to numeric to prevent any inconsistencies
  if (is.integer(priority))
    priority <- as.numeric(priority)

  if (!is.numeric(priority))
    stop('priority must be an integer or numeric')

  # Check length
  if (length(priority) == 0) {
    warning('Zero-length priority vector was passed; using 0')
    priority <- 0
  } else if (length(priority) > 1) {
    warning('Priority has length > 1 and only the first element will be used')
    priority <- priority[1]
  }

  # NA == 0
  if (is.na(priority))
    priority <- 0

  return(priority)
}

# pq <- PriorityQueue$new()
# pq$enqueue('a', 1)
# pq$enqueue('b', 1L)
# pq$enqueue('c', 1)
# pq$enqueue('A', 2)
# pq$enqueue('B', 2L)
# pq$enqueue('C', 2)
# pq$enqueue('d', 1)
# pq$enqueue('e', 1L)
# pq$enqueue('f', 1)
# pq$enqueue('D', 2)
# pq$enqueue('E', 2L)
# pq$enqueue('F', 2)
# # Expect ABCDEFabcdef