Nothing
#' Test the Multiple Approximate Kernel Learning (MAKL) Model
#'
#' Binary classification of the test data, using the MAKL model resulted from makl_train().
#'
#' @param X test dataset, matrix of size T x d.
#' @param y response vector of length T, containing only -1 and 1.
#' @param makl_model a list containing the MAKL model returning from makl_train().
#'
#' @return a list containing the predictions for test instances and the area under the ROC curve (AUROC) values with corresponding number of used kernels for prediction.
#' @export
#'
#' @examples
makl_test <- function(X, y, makl_model) {
N_group <- length(makl_model$membership)
feature_names <- sort(unique(unlist(sapply(1:N_group, FUN = function(x) {makl_model$membership[[x]]}))))
X <- X[, which(colnames(X) %in% feature_names)]
X_test <- X[, makl_model$valid_features]
X_test <- (X_test - matrix(makl_model$mean, nrow = nrow(X_test), ncol = ncol(X_test), byrow = TRUE)) / matrix(makl_model$sd, nrow = nrow(X_test), ncol = ncol(X_test), byrow = TRUE)
Z_test <- matrix(0, nrow = nrow(X_test), ncol = 2 * makl_model$D * N_group)
for(m in 1:N_group) {
feature_indices <- which(colnames(X_test) %in% makl_model$membership[[m]])
Z <- sqrt(1 / makl_model$D) * cbind(cos(X_test[, feature_indices] %*% makl_model$W[[m]] + matrix(makl_model$b[[m]], nrow = nrow(X_test), ncol = makl_model$D, byrow = TRUE)), sin(X_test[, feature_indices] %*% makl_model$W[[m]] + matrix(makl_model$b[[m]], nrow = nrow(X_test), ncol = makl_model$D, byrow = TRUE)))
Z_test[,((m - 1) * 2 * makl_model$D + 1):(m * 2 * makl_model$D)] <- Z
}
y_predicted <- stats::predict(makl_model$model, cbind(Z_test, 1))
auroc_array <- array(0, dim = length(makl_model$lambda_set), dimnames = list(sprintf("%g", makl_model$lambda_set)))
for(lambda in makl_model$lambda_set) {
k <- which(makl_model$lambda_set == lambda)
auroc_array[k] <- AUC::auc(AUC::roc(predictions = y_predicted[, k], labels = as.factor(y / 2 + 0.5)))
}
coefficient_matrix <- array(0, dim = c(2 * makl_model$D, N_group, length(makl_model$lambda_set)), dimnames = list(1:(2 * makl_model$D), 1:N_group, sprintf("%g", makl_model$lambda_set)))
for(m in 1:N_group) {
coefficient_matrix[,m,] <- makl_model$model$coefficients[((m - 1) * 2 * makl_model$D + 1):(m * 2 * makl_model$D),]
}
pathway_norms <- matrix(NA, nrow = N_group, length(makl_model$lambda_set))
colnames(pathway_norms) <- sprintf("%g", makl_model$lambda_set)
n_selected_kernels <- array(NA, dim = length(makl_model$lambda_set))
for(lambda in makl_model$lambda_set) {
k <- which(makl_model$lambda_set == lambda)
pathway_norms[, k] <- sapply(1:N_group, function(p) {sqrt(sum(coefficient_matrix[,p,k]^2))})
n_selected_kernels[k] <- length(which(pathway_norms[,k] > 0))
}
auroc_vs_kernel_number <- cbind(auroc_array, n_selected_kernels)
return(list(y_predicted = y_predicted, auroc_kernel_number = auroc_vs_kernel_number))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.