R/deploy.tile_Function.R

In Ehsan-F/R-Mixtape: Mixtape: Enhancing the model making process

deploy.tile <- function (df_deploy = ds, df_train = ds1, prob = "p_", 
                         tile_name = "p_Tile", model = NULL, model_var = "X1", n = 10) 
{
  all <- deparse(substitute(df_deploy))
  
  df_deploy <- as.data.frame(df_deploy)
  df_train <- as.data.frame(df_train)
  
  # Assign Predictions
  if (class(model)[1] == "glm") {
    df_deploy[, prob] <- predict(model, df_deploy, type = "response")
  }
  else if (class(model)[1] == "train") {
    df_deploy[, prob] <- predict(model, df_deploy, type = "prob")[, model_var]
  }
  
  #================================================================================#
  
  # Assign Tiles
  df_train[, tile_name] <- ntile(df_train[, prob], n = n)
  df_deploy[, tile_name] <- 0
  df_deploy[between(df_deploy[, prob], -Inf, max(df_train[df_train[, tile_name] == 
                                                            1, prob])), tile_name] <- 1
  for (i in 2:(n - 1)) {
    df_deploy[between(df_deploy[, prob], max(df_train[df_train[, tile_name] == 
                                                        i - 1, prob]) + 1e-08, max(df_train[df_train[, tile_name] == 
                                                                                              i, prob])), tile_name] <- i
  }
  df_deploy[between(df_deploy[, prob], (max(df_train[df_train[, tile_name] == n - 
                                                       1, prob]) + 1e-08), Inf), tile_name] <- n
  
  #================================================================================#
  
  # Assign to Datasets
  assign(all, df_deploy, envir = .GlobalEnv)

  list(All = table(df_deploy[, tile_name]))  
  
}