R/greedy_knapsack.R

#' Solve knapsack problem by Greedy heuristic. This approach is of complexity O(nlog(n))
#'
#' @param x data.frame, first column x:weight of object, second column v:value of object
#' @param W numeric, weight limit of knapsack
#'
#' @return list, value: total value of objects, elements: the rows of objects
#'
#' @examples
#' data(knapsack_objects)
#' greedy_knapsack(x = knapsack_objects[1:800,], W = 3500)
#' greedy_knapsack(x = knapsack_objects[1:1200,], W = 2000)
#'
#' @export
greedy_knapsack <- function(x, W) {
  #--------------------------------------------------------------------------------
  # Stop checking
  #--------------------------------------------------------------------------------
  if (!is.data.frame(x) || !is.numeric(W)) {
    stop("wrong input")
  }

  if (all(names(x) != c("w", "v"))) {
    stop("the name of columns have to be 'w' and 'v'")
  }

  if (!is.numeric(x$w) || !is.numeric(x$v)) {
    stop("the value of data.frame columns have to be positive number")
  }

  if (!all(x$w > 0) || !all(x$v > 0)) {
    stop("the value of data.frame columns have to be positive number")
  }

  #--------------------------------------------------------------------------------
  # Initialize return values
  #--------------------------------------------------------------------------------
  # rowname for retrun elements
  rownames(x) <- 1:nrow(x)
  sum_weight <- 0
  sum_value <- 0
  elements <- c()

  # delete the rows which weight are already over weight limit W
  i <- which(x$w > W)
  if (length(i) > 0) {
    x <- x[-i, ]
  }
  # calculate value per weight
  x$v_per_w <- x$v/x$w
  x <- x[order(x$v_per_w, decreasing = TRUE), ]

  #--------------------------------------------------------------------------------
  # Greedy heuristic - Time complexity:O(nlog(n))
  #--------------------------------------------------------------------------------
  for (i in 1:nrow(x)) {
    # sum of objects weight
    w <- sum_weight + sum(x[i, "w"])

    # add value and weight if total weight samller than limit W
    if (w <= W) {
      sum_weight <- w
      sum_value <- sum_value + x[i, "v"]
      elements <- c(elements, rownames(x[i, ]))
    } else if (w > W) {
      # Fractional Knapsack Problem
      # remain_weight <- W - sum_weight
      # sum_value <- sum_value + (remain_weight/x[i, "w"])*x[i, "v_per_w"]
      # elements <- c(elements, rownames(x[i, ]))
      return(list(value = round(sum_value, 0), elements = as.numeric(elements)))
    }
    # if i is the last row return answer
    if (i == nrow(x)) {
      return(list(value = round(sum_value, 0), elements = as.numeric(elements)))
    }
  }
}
shihs/LiUAdRLab6 documentation built on May 30, 2019, 7:18 a.m.