In pedism/knapsackalg: Solves knapsack problem

This vignette summarizes three functions of Knapsack package and gives examples on how to use them. The 3 functions are,

1. Brute force algorithm
2. Dynamic algorithm
3. Greedy approximation algorithm

These functions takes a data.frame x with two variables v and w and returns the maximum knapsack value and which elements (rows in the data.frame).

1.Brute force algorithm

brute_force_knapsack <- function(x,W)
{
  stopifnot(is.data.frame(x))
  stopifnot(W>0)
  value <- 0
  elem <-c()

  for(i in 1:(2^nrow(x)-1))
  {wsum <- 0
  vsum <- 0
  loop <-c()
  binary <- intToBits(i)

  for(j in 1:length(binary))
  {if( binary[j] == TRUE )
  {
    wsum <- wsum + x[j,1]
    vsum <- vsum + x[j,2]
    loop <- c(loop,j)
  }

  }

  if(vsum > value && wsum <= W)
  {value<-vsum 
  elem<-loop}}

  return(list(value=round(unname(value)),elements=elem))
}

Paralellized version

library(parallel)
par <- function(x,W)
{
  last_value <- 0
  last_vector <-c()
  rows<-(2^nrow(x)-1) * 32

  #first int function, it receives all combinations (7x32)
  step1 <- function(rows)
  {
    w_sum <- 0
    v_sum <- 0
    last_p <-0
    i <- 1:(2^nrow(x)-1)
    j <- 1:32
    #matrix repeats 32 (7 times), repeat 7 (32 times)
    mat_ij <- matrix(c(rep ( j , (2^nrow(x)-1) ),rep (i,32)),ncol=2)
    binary <- intToBits(mat_ij[rows,2])
    #for 1 (1), for 2 (2), for 3 (1,2) for 4 (3), for 5(1,3)...
    if (binary[mat_ij[rows,1]] == TRUE)
    {
      w_sum <- w_sum + unname(x[mat_ij[rows,1],1])
      v_sum <- v_sum + unname(x[mat_ij[rows,1],2])
      last_p <- mat_ij[rows,1]
    }
    list(w=w_sum,v=v_sum,p=last_p)
  }

  all_posibilities <-mclapply(1:rows,step1, mc.cores = 2)
  resvec <- unlist(all_posibilities) 



  step2 <- function(i)
  {
    start <- 96*(i-1)+1
    end <- 96*i
    temp1 <- resvec[start:end]
    weightsum <- sum(temp1[which(names(temp1) == "w")])
    weightsum <- unname(weightsum)
    valuesum <- sum(temp1[which(names(temp1) == "v")])
    valuesum <-unname(valuesum)
    packetschosen <- temp1[which(names(temp1) == "p")]
    packetschosen <- packetschosen[-which(packetschosen == 0)]
    packetschosen <-unname(packetschosen)
    list(w=weightsum,v=valuesum,p=packetschosen)
  }
  #only considering valid options.
  list_valid_weight <-mclapply(1:(rows * 3 / 96),step2, mc.cores = 2)


  lengthy <-length(list_valid_weight)

  step3 <- function(number){
    if(list_valid_weight[[number]]$w > W){
      return(list(v=0,p=c(0,0)))
    }else{
      return(list(v=unname(list_valid_weight[[number]]$v),p=unname(list_valid_weight[[number]]$p)))
    }
  }

  step3 <-mclapply(1:lengthy,step3, mc.cores = 2)

  values <- unlist(step3)
  values <- values[which(names(values)=="v")]
  last_value <- max(values)
  last_vector <- max.col(matrix(values,nrow=1)) 
  list(value=round(unname(last_value)),elements = step3[[last_vector]]$p)
}

doesnt work on windows stackoverflow.com/questions/17196261/understanding-the-differences-between-mclapply-and-parlapply-in-r

Run time for 16 objects

ptm <- proc.time()
n <- 16
knapsack_objects <- data.frame(
  w=sample(1:4000, size = n, replace = TRUE),
  v=runif(n = n, 0, 10000))
brute_force_knapsack(x = knapsack_objects[1:12,], W = 2000)
proc.time() - ptm

2.Dynamic algorithm

knapsack_dynamic <- function(x, W){
  stopifnot(is.data.frame(x) == TRUE)
  stopifnot(is.numeric(W) == TRUE)
  n <- nrow(x)
  w <- x[[1]]  #weights
  v <- x[[2]]  #values
  capacity <- W     #capacity of knapsack
  elem <- c()
  m <- matrix(0,nrow = n+1,ncol = capacity+1)

  #to return the max value 
  for (i in 2:n){
    for (j in 1:capacity){
      if (j > w[i]) 
        m[i, j] <- max(m[i-1, j-w[i]] + v[i], m[i-1, j])
      else 
        m[i,j] <- m[i-1, j]
    }
  }

  val <- m[i, j]
  value <- round(val)

  #to print the elements
  while(capacity>0 && n-1>0){
    if(m[n,capacity]!=m[n-1,capacity]){
      elem<-c(elem,n)
      capacity<-capacity-w[n]
      elements <- sort(elem)
    }
    n<-n-1
  }
  return(list("value"=value,"elements"=elements))

}

Run time for 500 objects

ptm <- proc.time()
n <- 500
knapsack_objects <- data.frame(
  w=sample(1:4000, size = n, replace = TRUE),
  v=runif(n = n, 0, 10000))
knapsack_dynamic(x = knapsack_objects[1:12,], W = 2000)
proc.time() - ptm

3.Greedy approximation algorithm

greedy_knapsack <- function(x,W){
  stopifnot(is.data.frame(x))
  stopifnot(W>0)
  df <- transform(x, c= v/w )
  df<- df[order(df$c,decreasing = TRUE),]
  w8  <- vector()
  j=0
  Val <- vector()
  elements <- vector()
  while(sum(w8) <= W)
  {
    w8 <-  append(w8,df$w[j])
    Val <- append(Val,df$v[j])
    j <- j+1

  }

  if(sum(w8)> W)
  { 
    w8 <- head(w8,-1)
    Val <- head(Val,-1)
  }
  Val
  elements <- append(elements,which(x$w  %in% w8))
  results <- list("value"= sum(Val),"elements"=elements)
  return(results)

}

Run time for 1000000 objects

ptm <- proc.time()
n <- 1000000
knapsack_objects <- data.frame(
  w=sample(1:4000, size = n, replace = TRUE),
  v=runif(n = n, 0, 10000))
greedy_knapsack(x = knapsack_objects[1:1200,], W = 2000)
proc.time() - ptm

Examples

For brute force method

#brute_force_knapsack(x = knapsack_objects[1:8,], W = 3500)
#brute_force_knapsack(x = knapsack_objects[1:12,], W = 2000)

For dynamic approach

#knapsack_dynamic(x = knapsack_objects[1:8,], W = 3500)
#knapsack_dynamic(x = knapsack_objects[1:12,], W = 2000)

For greedy approach

#greedy_knapsack(x = knapsack_objects[1:800,], W = 3500)
#greedy_knapsack(x = knapsack_objects[1:1200,], W = 2000)

See also

1. "Description of Knapsack problem" (via)

2. "Pseudocode to implement dynamic algorithm" (via)

3. "To implement greedy approach" (via)

4. "To measure the run time of code chunk" (via)

pedism/knapsackalg documentation built on May 30, 2019, 7:18 a.m.