R/success.R

In mlhutchins/fast-analytics: Fast Prototyping of Analysis Scripts

#' Plot success metrics with confidence intervals
#'
#' \code{\link{successPlot}} is the base plotting function that is called by the
#' wrapper for each KPI.
#'
#' @param test_id Test ID for the success metrics
#' @param ylabel Optional ylabel (just the label text)
#' @param extra Additional plot layers (fully specified)
#' @return Returns standard fast-analysis structured list
#' @name successPlot
#' @family skeletonPlots
successPlot <- function(test_id, ylabel = NA, extra = NA) {

    if (!is.na(ylabel)) {
        ylabel <- sprintf(" +\n    ylab('%s')", ylabel)
    } else {
        ylabel <- ''
    }

    if (!is.na(extra)) {
        extra <- sprintf(' + \n    %s', extra)
        extra <- paste0(extra, collapse = '')
    } else {
        extra <- ''
    }

    plot <- sprintf("
df <- data[data$test_type_id == %g, ]

df2 <-  ddply(df, .(carrier), summarise,
            var = mean(percentage_task_success, na.rm = TRUE),
            var_ul = getCI(percentage_task_success, func = 'mean')$upper,
            var_ll = getCI(percentage_task_success, func = 'mean')$lower)
df3 <-  ddply(df, .(carrier), summarise,
            var = mean(percentage_access_success, na.rm = TRUE),
            var_ul = getCI(percentage_access_success, func = 'mean')$upper,
            var_ll = getCI(percentage_access_success, func = 'mean')$lower)
df2$type <- 'Task'
df3$type <- 'Access'

df <- rbind(df3, df2)

plt <- ggplot(df, aes(x = type,
					  y = var,
					  ymax = var_ul,
					  ymin = var_ll,
					  color = carrier,
					  group = carrier)) +
	geom_pointrange(position = position_dodge(width = 0.3)) +
	scale_color_root() +
	theme_root() +
    scale_y_continuous(labels = percent) +
	xlab('') +
    ylab('') %s%s
print(plt)", test_id, ylabel, extra)

    return(plot)

}

#' @rdname successPlot
#' @export
downloadSuccessPlot <- function() {
    save <- 'download_success'
    data <- pullTestSummary()
    plot <- paste("\n#### Download Success Plot",
                  successPlot(20),
                  saveLine(save),
                  sep = "")
    output <- list(data = data,
                   plot = plot,
                   save = save)
    return(output)
}

#' @rdname successPlot
#' @export
uploadSuccessPlot <- function() {
    save <- 'upload_success'
    data <- pullTestSummary()
    plot <- paste("\n#### Upload Success Plot",
                  successPlot(19),
                  saveLine(save),
                  sep = "")
    output <- list(data = data,
                   plot = plot,
                   save = save)
    return(output)
}

#' @rdname successPlot
#' @export
ldrSuccessPlot <- function() {
    save <- 'ldr_success'
    data <- pullTestSummary()
    plot <- paste("\n#### LDR Success Plot",
                  successPlot(21),
                  saveLine(save),
                  sep = "")
    output <- list(data = data,
                   plot = plot,
                   save = save)
    return(output)
}

#' @rdname successPlot
#' @export
emailSuccessPlot <- function() {
    save <- 'email_success'
    data <- pullTestSummary()
    plot <- paste("\n#### E-Mail Success Plot",
                  successPlot(13),
                  saveLine(save),
                  sep = "")
    output <- list(data = data,
                   plot = plot,
                   save = save)
    return(output)
}