#define####
defineSparseMat <- function(data,
binary,
minimum,
maximum,
intScale,
positiveThreshold){
data <- as.data.frame(data)
if(NCOL(data)>3) stop("Currently Rrecsys can manage only user-item rating matrices! Your dataset has more than 3 columns, please check it.")
cat("WARNING: Please make sure that columns first to third are respectively user's IDs, item's IDs and user's score for that item.\n\n")
names(data) <- c("user", "item", "score")
data <- data[order(data$user, data$item), ]
# Remove all the rows where is missing a valid score.
if(binary){
data <- data[-which(data$score < positiveThreshold), ]
}
# Ids of the user.
userID <- unique(data$user)
# Ids of the items.
itemID <- unique(data$item)
# Number of users.
nrUsers <- length(userID)
# Number of items.
nrItems <- length(itemID)
# Number of ratings.
nrScores <- length(data$score)
# Pointers to users position in the data goruped by ID.
userPointers <- getPointers(userID, data$user)
# Pointers to items position in the data goruped by ID.
itemPointers <- getPointers(itemID, data$item)
# Map user and item IDs to continous values.
for(i in 1:length(userPointers)) data$user[userPointers[[i]]] <- i
for(i in 1:length(itemPointers)) data$item[itemPointers[[i]]] <- i
rownames(data) <- NULL
new("sparseDataSet",
data = data,
binary = binary,
minimum = minimum,
maximum = maximum,
intScale = intScale,
userID = userID,
itemID = itemID,
userPointers = userPointers,
itemPointers = itemPointers
)
#END
}
#Conver####
setMethod("convert2DataSet", signature(x = "sparseDataSet"), function(x){
data <- matrix(NA, nrow = nrow(x), ncol = ncol(x))
idx <- nrow(x) * (x@data$item-1) + x@data$user
data[idx] <- x@data$score
new("dataSet",
data = data,
binary = x@binary,
minimum = x@minimum,
maximum = x@maximum,
intScale = x@intScale)
})
#SHOW####
#getPointers####
getPointers <- function(IDs, vector){
lapply(IDs, function(i) which(vector == i))
}
#dim####
setMethod("dim", signature(x = "sparseDataSet"), function(x) c(nrow(x),ncol(x)))
#ncol####
setMethod("ncol", signature(x = "sparseDataSet"), function(x) length(x@itemID))
#nrow####
setMethod("nrow", signature(x = "sparseDataSet"), function(x) length(x@userID))
#colRatings####
setMethod("colRatings", signature(x = "sparseDataSet"), function(x) {
s <- sapply(x@itemPointers, length)
s
})
#rowRatings####
setMethod("rowRatings", signature(x = "sparseDataSet"), function(x) {
s <- sapply(x@userPointers, length)
s
})
#numRatings####
setMethod("numRatings", signature(x = "sparseDataSet"), function(x) {
nrow(x@data)
})
#colMeans####
setMethod("colAverages", signature(x = "sparseDataSet"), function(x, damping) {
if(missing(damping)){
m <- sapply(x@itemPointers, function(i) sum(x@data$score[i]))/colRatings(x)
m[which(is.na(m))] <- 0
m
}else{
m <- sapply(x@itemPointers, function(i) sum(x@data$score[i]))/(colRatings(x) + damping)
m[which(is.na(m))] <- 0
m
}
})
#rowMeans####
setMethod("rowAverages", signature(x = "sparseDataSet"), function(x, damping) {
if(missing(damping)){
m <- sapply(x@userPointers, function(i) sum(x@data$score[i]))/rowRatings(x)
m[which(is.na(m))] <- 0
m
}else{
m <- sapply(x@userPointers, function(i) sum(x@data$score[i]))/(rowRatings(x) + damping)
m[which(is.na(m))] <- 0
m
}
})
#Possible optimization!!!####
setMethod("[", signature(x = "sparseDataSet", i = "ANY", j = "ANY", drop = "missing"), function(x, i, j, ..., drop) {
if (missing(i))
i <- 1:nrow(x)
if (missing(j))
j <- 1:ncol(x)
if(class(i) == "logical")
i <- which(i)
if(class(i) == "logical")
j <- which(j)
i <- unlist(x@userPointers[i])
j <- unlist(x@itemPointers[j])
new_x <- x@data[i[which(i %in% j)],]
defineData(new_x, sparseMatrix = TRUE, binary = x@binary,
minimum = x@minimum, maximum = x@maximum, intScale = x@intScale)
})
setMethod("averageRating", signature(x = "sparseDataSet"), function(x) {
sum(x@data$score)/numRatings(x)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.