Implement flip trick

[wlattner]

This is another transformed outcome method:

hete_flip_trick <- function(fold_id, x, y, tmt, folds) {
  x_train <- x[folds != fold_id, ]
  x_test <- x[folds == fold_id, ]
  
  y_train <- y[folds != fold_id]
  y_test <- y[folds == fold_id]
  
  tmt_train <- tmt[folds != fold_id]
  tmt_test <- tmt[folds == fold_id]
  
  # the "flip trick", see "Uplift modeling for clinical trial data"
  y_star_train <- ifelse(y_train == tmt_train, 1, 0)
  
  m <- gbm.fit(x_train, y_star_train, distribution = "bernoulli", n.trees = 1000)
  test_preds <- predict(m, as.matrix(x_test), type = "response",
                        n.trees = m$n.trees)
  # un-flip
  test_preds <- (2*test_preds) - 1
  
  test_df <- data.frame(
    predicted_te = test_preds,
    observed_y = y_test,
    treatment = tmt_test
  )
  
  return(test_df)
}