R/knapsack_dynamic.R

In mpirmoradiyan/knapsack: Three approaches to deal with knapsack problem

#' Dynamic programming algorithm for solving knapsack problem
#'
#' \code{knapsack_dynamic(x, W)} returns  the solution for knapsack problem
#' using Dynamic programming algorithm.
#'
#' This function solves the Knapsack probem using Dynamic programming approach.
#' The knapsack problem is a discrete optimization problem where we have a
#' knapsack that can take a limited weight W and we want to fill this knapsack
#' with a number of items i = 1, 2 ,...,n; each with a weight(w) and a value(v).
#' The goal is to find the knapsack with the largest value of the elements added
#' to the knapsack.
#'
#' @param x A data.frame with two variables ("w" , "v"). Every observation (row)
#'   in this data frame is an item with a weight (w) and a value (v).
#'
#' @param W A numeric scalar which is the maximum capacity of the knapsack.
#'
#'
#'
#' @return  A list with names \code{$value}, indicating maximum value of the
#'   items picked into the the knapsack , and \code{$elements} which states
#'   which items (rows) in data.frame were selected out to put into the
#'   knapsack.
#'
#'
#' @examples
#'  knapsack_dynamic(data.frame(w=c(3660,3749,1145,3322),v=c(9899,4384,6999,8890)),W =3500)
#'
#' @references
#'   \url{https://en.wikipedia.org/wiki/Knapsack_problem#0.2F1_knapsack_problem}
#' @export
#' 

knapsack_dynamic <- function(x, W){
  
  stopifnot(is.data.frame(x))
  stopifnot(names(x) == c("w", "v"))
  stopifnot(x[] > 0)
  stopifnot(is.numeric(W), length(W) == 1, W > 0)
  
  x_new <- rbind(c(0,0), x)
  n <- nrow(x_new)
  m = matrix(NA, nrow = n+1, ncol = W+1)
  
  m[1,] <- 0
  m[,1] <- 0
  
  
  for (i in 2:n) {
    for (j in 2:W) {
      
      if(j >= x_new$w[i]){
        m[i, j] <- max(m[i-1, j],m[i-1, j-x_new$w[i]] + x_new$v[i])
      }else{
        m[i, j] <- m[i-1, j]
      }
    }
  }
  
  value <- m[n,W]
  
  
  N <- n
  c <- W
  elements <- c()
  currValue <- m[N,c]

  while(N > 1){

    if(currValue %in% m[N-1,] == FALSE){

      elements <- c(elements, N-1)
      currValue <- currValue - x_new$v[N]
      N <- N-1
    }else{
        N<- N-1
        }
  }
  return(list(value = round(value), elements = rev(elements)))
}