R/testing.R

In signaux-faibles/MLsegmentr: Model evaluation on data segments

#' Get a test eval_frame
#'
#' Returns a test eval frame in the same format than it is expected inside and
#' Assesser object.
#'
#' @return A data.frame of 200 lines, based on iris dataset. Columns are .id
#' (numeric), prediction (numeric), prediction_type (factor, "model_1" for 100 first
#' lines, "model_2" for 100 next), segment (factor, alternating "segment_1"
#' and "segment_2", target (boolean) and target_type (factor, unique target
#' "target")
#'
#' @export
get_test_eval_frame  <- function(){

  iris.small <- dplyr::filter(
    datasets::iris,
    Species %in% c("virginica", "versicolor")
  )
  iris.small$Species[1] <- "virginica"
  iris.small$Species[97] <- "versicolor"
  set.seed(1)
  iris.small <- iris.small[sample(nrow(iris.small)), ]

  glm_out <- glm(Species ~ Sepal.Width + Petal.Width + Petal.Length,
    data = iris.small,
    family = binomial)
  pred <- glm_out$fitted.values

  set.seed(1234)
  pred_mod <- 0.5 + runif(length(pred), 0, 1) * (pred - 0.5)

  test_eval_frame <- data.frame(
    .id = rep(1:100, 2),
    prediction_type = rep(
      as.factor(c("model_1", "model_2")),
      each = length(pred)
    ),
    prediction = c(pred, pred_mod),
    segment = rep(as.factor(c("segment_1", "segment_2")), length(pred)),
    target_type = as.factor("target"),
    target = rep( iris.small$Species == "virginica", 2)
  )
  return(test_eval_frame)
}


#' Get a test input frame for the assesser
#'
#' Returns an input frame that results in the evaluation frame outputed by
#' get_eval_frame.
#'
#'  @return
#'  @export
get_test_input_frame <- function(){
  test_eval_frame <- get_test_eval_frame()
  test_input_frame <- data.frame(
    .id = test_eval_frame[1:100, ".id"],
    model_1 = test_eval_frame[1:100, "prediction"],
    model_2 = test_eval_frame[101:200, "prediction"],
    segment = test_eval_frame[1:100, c(4)],
    target_type = test_eval_frame[1:100, c(5)],
    target = test_eval_frame[1:100, c(6)]
  )
  return(test_input_frame)
}