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

knitr::opts_chunk$set(echo = TRUE)
# Update package
# devtools::install_github(repo = "signaux-faibles/MLsegmentr")
devtools::load_all()

train <- mtcars[1:20,]
test <- mtcars[-(1:20), ]

Training function

train_fun <- function(train, features, outcome){
  model <- glm(as.formula(paste(outcome, "~", paste(features, collapse = " + "))), data = train, family = "binomial")
  return(model)
}

test_fields <- c("mpg", "cyl", "hp", "drat")
test_outcome <- "vs"
test_model <- train_fun(train, names(train)[names(train) != test_outcome], test_outcome)

Predict function

predict_fun <- function(
  model, 
  new_data
  ){
  return(predict.glm(model, new_data, type ="response"))
}

test_prediction <- predict_fun(test_model, test)

Evaluation function

eval_fun <- function(outcome, predicted){
  PR <-  PRROC::pr.curve(scores.class0 = predicted,
                  weights.class0 =  as.numeric(outcome),
                  curve = TRUE)

  return( max(2 * PR$curve[, 1] * PR$curve[, 2] / (PR$curve[, 1] + PR$curve[, 2]), na.rm = TRUE))
}

eval_fun(test_prediction, test[[outcome]])

test

assess_on_features(train, test, list(c("mpg", "cyl", "hp", "drat"), c("mpg", "cyl")), "vs", train_fun, predict_fun, eval_fun)

signaux-faibles/MLsegmentr documentation built on Aug. 29, 2019, 2:22 p.m.