From 95697d03bcb4331a1cfbd7099143bdfcd4513411 Mon Sep 17 00:00:00 2001 From: Cesaire Joris Kuete Fouodo Date: Wed, 27 Nov 2024 17:34:00 +0100 Subject: [PATCH] Version 1.1 --- R/BestSpecificLearner.R | 78 ----------------------- R/predict.bestSpecificLearner.R | 39 ------------ man/bestSpecificLearner.Rd | 32 ---------- man/predict.bestSpecificLearner.Rd | 33 ---------- tests/testthat/test-bestSpecificLearner.R | 37 ----------- 5 files changed, 219 deletions(-) delete mode 100644 R/BestSpecificLearner.R delete mode 100644 R/predict.bestSpecificLearner.R delete mode 100644 man/bestSpecificLearner.Rd delete mode 100644 man/predict.bestSpecificLearner.Rd delete mode 100644 tests/testthat/test-bestSpecificLearner.R diff --git a/R/BestSpecificLearner.R b/R/BestSpecificLearner.R deleted file mode 100644 index 99acb53..0000000 --- a/R/BestSpecificLearner.R +++ /dev/null @@ -1,78 +0,0 @@ -#' @title The best layer-specific model is used as meta model. -#' -#' @description -#' The meta learner is the best layer-specific laerner. -#' -#' @param x `data.frame(1)` \cr -#' \code{data.frame} of predictors. -#' @param y `vector(1)` \cr -#' Target observations. Either binary or two level factor variable. -#' @param perf `function(1)` \cr -#' Function to compute layer-specific performance of learners. If NULL, the Brier Score is used by default as performance measure. -#' Otherwise, the performance function must accept two parameters: \code{observed} (observed values) and \code{predicted} (predicted values). -#' -#' @return -#' A model object of class \code{weightedMeanLeaner}. -#' -#' @export -#' -#' @examples -#' set.seed(20240624L) -#' x = data.frame(x1 = runif(n = 50L, min = 0, max = 1)) -#' y = sample(x = 0L:1L, size = 50L, replace = TRUE) -#' my_best_model = bestSpecificLearner(x = x, y = y) -#' -bestSpecificLearner = function (x, y, perf = NULL) { - if (!is.data.frame(x)) { - stop("x must be a data.frame.") - } - if (is.null(perf)) { - if (is.numeric(y) & (length(unique(y)) > 2)) { - perf_values = lapply(X = x, FUN = function (predicted) { - mean(x = (predicted - y)^2, na.rm = TRUE) - }) - } else { - if ((length(unique(y)) > 2) | is.character(y)) { - stop("y must be either binary or two level factor variable.\n") - } else { - if (is.factor(y)) { - y = as.integer(y) - 1 - } else { - if (!all(y %in% 0:1)) { - stop("y must take its values between 0 and 1.\n") - } - } - perf_values = lapply(X = x, FUN = function (predicted) { - mean(x = (predicted - y)^2, na.rm = TRUE) - }) - } - } - perf_values = unlist(perf_values) - } else { - # nocov start - if (is.function(perf)) { - arg_names <- names(formals(perf)) - if (arg_names %in% c("observed", "predicted")) { - # Function has been provided to estimated performance of layer-specific learner - perf_values = lapply(X = x, FUN = function (predicted) { - perf_estimate = do.call(what = perf, args = list(observed = y, - predicted = predicted)) - return(perf_estimate) - }) - perf_values = unlist(perf_values) - } else { - stop("perf argument must be a function.") - } - } else { - stop("Arguments of the perf function must be 'observed' and 'predicted'.") - } - } - # nocov end - weights_values = (1L / perf_values) / sum((1L / perf_values)) - max_index = which.max(weights_values) - weights_values = rep(0L, length(weights_values)) - weights_values[max_index] = 1L - names(weights_values) = names(x) - class(weights_values) = "bestSpecificLearner" - return(weights_values) -} diff --git a/R/predict.bestSpecificLearner.R b/R/predict.bestSpecificLearner.R deleted file mode 100644 index 9828811..0000000 --- a/R/predict.bestSpecificLearner.R +++ /dev/null @@ -1,39 +0,0 @@ -#' @title Weighted mean prediction. -#' -#' @description -#' Predict function for models from class \code{weightedMeanLearner}. -#' -#' @include weightedMeanLearner.R -#' -#' @param object `weightedMeanLearner(1)` \cr -#' An object from class [weightedMeanLearner] -#' @param data `data.frame` \cr -#' \code{data.frame} to be predicted. -#' @param na.rm \cr -#' Removes NAs when TRUE. -#' -#' @return -#' Predicted target values are returned. -#' -#' @export -#' @method predict bestSpecificLearner -#' @importFrom stats weighted.mean complete.cases -#' -#' @examples -#' set.seed(20240625) -#' x = data.frame(x1 = runif(n = 50L, min = 0, max = 1)) -#' y <- sample(x = 0:1, size = 50L, replace = TRUE) -#' my_model <- bestSpecificLearner(x = x, y = y) -#' x_new <- data.frame(x1 = rnorm(10L)) -#' my_predictions <- predict(object = my_model, data = x_new) -#' -predict.bestSpecificLearner = function (object, data, na.rm = TRUE) { - if (all(names(object) %in% names(data))) { - pred = apply(data[ , names(object), drop = FALSE], 1L, function (tmp_row) { - return(weighted.mean(x = tmp_row, w = object, na.rm = na.rm)) - }) - return(list(predictions = unlist(pred))) - } else { - stop("Names of weights do not match with name columns in data.") - } -} diff --git a/man/bestSpecificLearner.Rd b/man/bestSpecificLearner.Rd deleted file mode 100644 index 88f9a7f..0000000 --- a/man/bestSpecificLearner.Rd +++ /dev/null @@ -1,32 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/BestSpecificLearner.R -\name{bestSpecificLearner} -\alias{bestSpecificLearner} -\title{The best layer-specific model is used as meta model.} -\usage{ -bestSpecificLearner(x, y, perf = NULL) -} -\arguments{ -\item{x}{\code{data.frame(1)} \cr -\code{data.frame} of predictors.} - -\item{y}{\code{vector(1)} \cr -Target observations. Either binary or two level factor variable.} - -\item{perf}{\verb{function(1)} \cr -Function to compute layer-specific performance of learners. If NULL, the Brier Score is used by default as performance measure. -Otherwise, the performance function must accept two parameters: \code{observed} (observed values) and \code{predicted} (predicted values).} -} -\value{ -A model object of class \code{weightedMeanLeaner}. -} -\description{ -The meta learner is the best layer-specific laerner. -} -\examples{ -set.seed(20240624L) -x = data.frame(x1 = runif(n = 50L, min = 0, max = 1)) -y = sample(x = 0L:1L, size = 50L, replace = TRUE) -my_best_model = bestSpecificLearner(x = x, y = y) - -} diff --git a/man/predict.bestSpecificLearner.Rd b/man/predict.bestSpecificLearner.Rd deleted file mode 100644 index 3d1d7d4..0000000 --- a/man/predict.bestSpecificLearner.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/predict.bestSpecificLearner.R -\name{predict.bestSpecificLearner} -\alias{predict.bestSpecificLearner} -\title{Weighted mean prediction.} -\usage{ -\method{predict}{bestSpecificLearner}(object, data, na.rm = TRUE) -} -\arguments{ -\item{object}{\code{weightedMeanLearner(1)} \cr -An object from class \link{weightedMeanLearner}} - -\item{data}{\code{data.frame} \cr -\code{data.frame} to be predicted.} - -\item{na.rm}{\cr -Removes NAs when TRUE.} -} -\value{ -Predicted target values are returned. -} -\description{ -Predict function for models from class \code{weightedMeanLearner}. -} -\examples{ -set.seed(20240625) -x = data.frame(x1 = runif(n = 50L, min = 0, max = 1)) -y <- sample(x = 0:1, size = 50L, replace = TRUE) -my_model <- bestSpecificLearner(x = x, y = y) -x_new <- data.frame(x1 = rnorm(10L)) -my_predictions <- predict(object = my_model, data = x_new) - -} diff --git a/tests/testthat/test-bestSpecificLearner.R b/tests/testthat/test-bestSpecificLearner.R deleted file mode 100644 index 5005d27..0000000 --- a/tests/testthat/test-bestSpecificLearner.R +++ /dev/null @@ -1,37 +0,0 @@ -test_that("bestSpecificLearner works", { - expect_no_error({ - set.seed(20240624L) - x = data.frame(x1 = runif(n = 50L, min = 0, max = 1)) - y = sample(x = 0L:1L, size = 50L, replace = TRUE) - my_model = bestSpecificLearner(x = x, y = y) - x_new <- data.frame(x1 = rnorm(10)) - my_predictions <- predict(object = my_model, data = x_new) - }) - expect_error({ - set.seed(20240624L) - x = data.frame(x1 = runif(n = 50L, min = 0, max = 1)) - y = sample(x = 0L:1L, size = 50L, replace = TRUE) - my_model = bestSpecificLearner(x = x, y = y) - x_new <- data.frame(x2 = rnorm(10)) - my_predictions <- predict(object = my_model, data = x_new) - }) - expect_no_error({ - set.seed(20240624L) - x = data.frame(x1 = runif(n = 50L, min = 0, max = 1)) - y = sample(x = 0L:2L, size = 50L, replace = TRUE) - my_model = bestSpecificLearner(x = x, y = y) - }) - expect_no_error({ - set.seed(20240624L) - x = data.frame(x1 = runif(n = 50L, min = 0, max = 1)) - y = factor(sample(x = c("control", "case"), size = 50L, replace = TRUE)) - my_model = bestSpecificLearner(x = x, y = y) - }) - expect_no_error({ - set.seed(20240624L) - x = data.frame(x1 = runif(n = 50L, min = 0, max = 1)) - y = sample(x = c("0", "1"), size = 50L, replace = TRUE) - my_model = bestSpecificLearner(x = x, y = factor(y)) - }) -}) -