R/greedy_knapsack.R

Defines functions greedy_knapsack

Documented in greedy_knapsack

#'@title Greedy Heuristic Algorithm
#'@description Solution to the knapsack problem following a greedy approach.\cr
#' The algorithm solves the knapsack problem exact by iterating over all possible values of weight.\cr
#' Do not expect an exact result.
#'@references \href{https://en.wikipedia.org/wiki/Knapsack_problem#Greedy_approximation_algorithm}{Wikipedia}
#'@param x Dataframe with variables v and w.
#'@param W Integer. Size of the knapsack.
#'@export
#'@aliases gka
#'@return Returns a list with the total final value and the items added to the knapsack.

greedy_knapsack<-function(x,W){
	if(!is.data.frame(x) | !("w" %in% colnames(x)) | !("v" %in% colnames(x))){
		stop("The first argument must be a dataframe with at least two variables: v and w")
	}
	if(!is.numeric(W)){
		stop("The weight limit (second argument) has to be a numeric object")
	}
	if(W<0){
		stop("The weight limit (second argument) cannot be a negative integer!")
	}
	
	greedy_output_list<-list("value"=0,"elements"=c())
	
	x$ratio <- x$v/x$w
	x_sorted <- x[order(x$ratio,decreasing=TRUE),]
	
	v <- x_sorted$v
	w <- x_sorted$w
	wloop <- W
	j <- 1
	i <- 1
	while(wloop>0){
		if(wloop>=w[i]){
			greedy_output_list$value = greedy_output_list$value + v[i]
			greedy_output_list$elements[j] <- which(x$v==v[i] & x$w==w[i])
		}
		wloop<-wloop-w[i]
		i<-i+1
		j<-j+1
	}
	greedy_output_list$value = round(greedy_output_list$value)
	return(greedy_output_list)
}

# Setup:
# set.seed(42)
# n <- 1000000
# knapsack_objects <- data.frame(w=sample(1:4000, size = n, replace = TRUE), v=runif(n = n, 0, 10000))

# How much time does it takes to run the algorithm for n = 1000000 objects? 20.73458 seconds
# start_time <- Sys.time()
# greedy_knapsack(x = knapsack_objects[1:1000000,], W = 3500)
# end_time <- Sys.time()
# cat("Runtime for 1000000 objects: ",end_time-start_time,"\n")

# Execution examples:
# greedy_knapsack(x = knapsack_objects[1:800,], W = 3500) # 192647
# greedy_knapsack(x = knapsack_objects[1:1200,], W = 2000) #212337
abhi-vellala/732A94lab6 documentation built on Oct. 31, 2019, 1:54 a.m.