Update LIFT chart

Author: agosiewska

DESCRIPTION

@@ -23,7 +23,7 @@ Imports: car,
     plotROC,
     ROCR,
     tseries
-RoxygenNote: 6.0.1
+RoxygenNote: 6.1.0
 Suggests: aods3,
     breakDown,
     DALEX,

R/modelEvaluation.R

@@ -10,6 +10,7 @@ modelEvaluation <- function(object, variable = NULL){
   if(!("modelAudit" %in% class(object))) stop("The function requires an object created with audit().")
 
   CGainsDF <- getCGainsDF(object)[-1,]
+  idealCGainsDF <- getidealCGainsDF(object)[-1,]
 
   result <- data.frame(
     y=object$y,
@@ -18,6 +19,7 @@ modelEvaluation <- function(object, variable = NULL){
 
     class(result) <- c("modelEvaluation", "data.frame")
     attr(result,'CGains') <- CGainsDF
+    attr(result,'idealCGains') <- idealCGainsDF
   return(result)
 }
 
@@ -35,3 +37,15 @@ getCGainsDF <- function(object){
   return(res)
 }
 
+getidealCGainsDF <- function(object){
+
+  predictions <- object$y
+  y <- as.numeric(as.character(object$y))
+
+  pred <- ROCR::prediction(predictions, y)
+  gain <- ROCR::performance(pred, "tpr", "rpp")
+
+  res <- data.frame(rpp = gain@x.values[[1]], tp = pred@tp[[1]], alpha = gain@alpha.values[[1]],
+                    label = "ideal")
+  return(res)
+}

R/plotLift.R

@@ -32,6 +32,14 @@ plotLIFT <- function(object, ...){
   rpp <- tp <- label <- NULL
 
   df <- attributes(object)$CGains
+  idealdf <- attributes(object)$idealCGains
+  idealdf <- rbind(idealdf, c(0, 0, 0, "ideal"))
+  idealdf$tp <- as.numeric(idealdf$tp)
+  idealdf$rpp <- as.numeric(idealdf$rpp)
+  idealdf$alpha <- as.numeric(idealdf$alpha)
+
+  randomdf <- data.frame(rpp = c(0, 1), tp = c(0, max(idealdf$tp)), alpha = c(0, 1),
+                                               label =c("random", "random"))
 
   dfl <- list(...)
   if (length(dfl) > 0) {
@@ -48,6 +56,8 @@ plotLIFT <- function(object, ...){
 
   ggplot(df, aes(x = rpp, y = tp, color = label)) +
     geom_line() +
+    geom_line(data = idealdf, aes(x = rpp, y = tp), color = "orange") +
+    geom_line(data = randomdf, aes(x = rpp, y = tp), color = "black") +
     xlab("rate of positive prediction") +
     ylab("true positive") +
     ggtitle("LIFT Chart") +

R/plotModelRanking.R

@@ -69,7 +69,7 @@ plotModelRanking <- function(object, ..., scores = c("MAE", "MSE", "REC", "RROC"
      df$scaled <- scr
      df$scaled <- format(as.numeric(df$scaled), scientific = FALSE, digits = 3)
      df$score <- format(df$score, scientific = TRUE, digits = 3)
-     df <- df[ ,c(3,2,4,1)]
+     df <- df[ ,c(3,2,1,4)]
 
 
     table_score <- tableGrob(df,

R/plotREC.R

@@ -54,6 +54,7 @@ plotREC <- function(object, ...){
                        labels = paste(seq(0, 100, 10),"%")) +
     theme_light() +
     xlab("error tolerance") +
+    ylab("") +
     ggtitle("REC Curve")
 
 }