AB Test Alpha 2

global.R

###############################################
##
##    Attempt no 2 at building a shiny web app
##    for AB Testing use - using global.R
##
##    global.R - loading and defining variables for the global environment
##
###############################################

# Pallette used in some charts as a general indicator color for better or worse that the control group
my.palette <- c("#00B81E", "#F8766D","#00A5FF")

get.ab.info <- function(){
  # information: Test, Type, Desc
  tmp <- read.csv(file='testinfo.csv',header=TRUE,sep=",",stringsAsFactors = FALSE)
  tmp$Start.Date <- tmp$Start.Date
  tmp$Last.Date <- tmp$Last.Date
  as.data.frame(tmp)
}
# Note, a means comparison test (number o actions per subject) can also be viewed from a proportions perspective (number of subjects who took at least 1 action). But generally NOT vice versa - proportion tests generally look at one-way actions such as upgrading and retention
get.exp.results <- function(){
  # Results: Test, Group, Size, Acted, Mean, Prop, SD.Sample
  read.csv(file='testdata.csv',header=TRUE,sep=",",stringsAsFactors = FALSE)
} 

# grab the data
data.updated <- reactiveValue(Sys.time())  # when this code fist ran and the files grabbed
ab.info <- reactiveValue(get.ab.info())
exp.results <- reactiveValue(get.exp.results())

# what is the max data from Last.Date in the test info file? An updated file friom the warehouse would have yesterdays date
data.age <- reactiveValue(isolate(as.integer(Sys.Date() - as.Date(max(value(ab.info)$Last.Date)))))

server.R

###############################################
##
##    Attempt no 2 at building a shiny web app
##    for AB Testing use - using global.R
##
##    server.R - Server logic definition
##
###############################################



# Required libraries
require(shiny)
require(plyr)  # data manipulation
require(ggplot2)  # plotting


# Define the required logic
shinyServer(function(input, output) {
  
  observe(function(){
    if(input$check.for.data > 0){
      isolate({
        # refresh has been clicked, so call the functions from the global.R file
        value(data.updated) <- Sys.time()
        value(ab.info) <- get.ab.info()
        value(exp.results) <- get.exp.results()
        value(data.age) <- as.integer(Sys.Date() - as.Date(max(value(ab.info)$Last.Date)))
      })
    }
  })
  
  # Send the value to the client so output can observe it
  output$dataAge <- reactive(function() {
    value(data.age)
  })
  
  output$last.refresh <- reactive(function() {
    as.character(value(data.updated))
  })
  
  # flag type of test
  output$mean <- reactive(function(){
    a <- value(ab.info)[,'Test'] == input$ab.test
    if(value(ab.info)[a,'Type'] == 'M'){
      TRUE
    } else {
      FALSE
    }
  })
  
  # Return the type of experiment and its description for display
  output$caption <- reactivePrint(function(){
    a <- value(ab.info)[,'Test'] == input$ab.test
    if(value(ab.info)[a,'Type'] == 'M'){
      c <- "Mean comparison"
    } else {
      # PROPORTION comparison
      c <- 'Proportion comparison'
    }
    # if the system date has incremented, then the data file is out of date, but refresh might not be available
    value(data.age) <- as.integer(Sys.Date() - as.Date(max(value(ab.info)$Last.Date)))
    paste(c[1])
  })
  output$desc <- reactivePrint(function(){
    a <- value(ab.info)[,'Test'] == input$ab.test
    if(value(ab.info)[a,'Type'] == 'M'){
      paste(value(ab.info)[a,'Desc'])
    } else {
      # PROPORTION comparison
      paste(value(ab.info)[a,'Desc'])
    }
  })
  
  # main calculatuion function, results used by all plots
  results <- reactive(function(){
    
    # Filter for the currently selected experiment only
    a <- value(exp.results)[,'Test'] == input$ab.test
    exp.data <- value(exp.results)[a,] 
    
    # Lift of each test cell
    exp.data <- mutate(exp.data, Lift.Mean = Mean - subset(exp.data, Group == '.Control')$Mean)  # change in mean compared to the control
    exp.data <- mutate(exp.data, Lift.Prop = Prop - subset(exp.data, Group == '.Control')$Prop)  # change in prop compared to the control
    
    # Means and proportions needs lightly different SD handling
    exp.data <- mutate(exp.data, SD.Prop = sqrt(Prop * (1 - Prop))/sqrt(Size))  # SD of the proportion
    exp.data <- mutate(exp.data, SD.Prop.Diff = sqrt(subset(exp.data, Group == '.Control')$SD.Prop^2 + SD.Prop^2))  # SD of the difference from the control
    exp.data <- mutate(exp.data, SD.Sample.Means = SD.Sample/sqrt(Size)) # SD of the sample means (not of a particular sample - central limit theorem)
    exp.data <- mutate(exp.data, SD.Sample.Mean.Diff = sqrt(subset(exp.data, Group == '.Control')$SD.Sample.Means^2 + SD.Sample.Means^2))  # SD of the difference in means
    
    
    # p.value, Upper and lower 95% confidence levels of means
    exp.data <- mutate(exp.data, P.Value.Mean = pt((Mean - subset(exp.data, Group == '.Control')$Mean)/(SD.Sample/sqrt(Size)), df=Size-1, lower.tail=FALSE) )
    exp.data <- mutate(exp.data, Lower.Mean = Mean - (SD.Sample.Means * 1.96), Upper.Mean = Mean + (SD.Sample.Means * 1.96))
    
    # p.value, Upper and lower 95% confidence levels of proportions
    tmp <- matrix(nrow=length(exp.data[,'Group']),ncol=3)
    for(n in 1:length(exp.data[,'Group'])){
      b <- prop.test(exp.data[n,'Acted'], exp.data[n,'Size'], p=subset(exp.data, Group == '.Control')$Prop, conf.level=0.95)
      tmp[n,1] <- unlist(b[3])
      tmp[n,2] <- unlist(b[6][[1]][1])
      tmp[n,3] <- unlist(b[6][[1]][2])
    }
    exp.data <- mutate(exp.data, P.Value.Prop = tmp[,1], Lower.Prop = tmp[,2], Upper.Prop = tmp[,3])
    
    # Percentage of test samples that would have a mean or proportion, greater than the mean control group
    exp.data <- mutate(exp.data, Pct.Mean.Grtr.C = pnorm(Lift.Mean, 0, SD.Sample.Mean.Diff,lower.tail=TRUE))
    exp.data <- mutate(exp.data, Pct.Mean.Grtr.CX = pnorm(Lift.Mean, input$mean.lift, SD.Sample.Mean.Diff,lower.tail=TRUE))
    exp.data <- mutate(exp.data, Pct.Prop.Grtr.C = pnorm(Lift.Prop, 0, SD.Prop.Diff,lower.tail=TRUE))
    exp.data <- mutate(exp.data, Pct.Prop.Grtr.CX = pnorm(Lift.Prop, input$prop.lift, SD.Prop.Diff,lower.tail=TRUE))
    
    # Which tests are statisically significant?
    exp.data <- mutate(exp.data, Signif.Mean=ifelse(exp.data[,'P.Value.Mean'] > (1 - input$significance),'N','Y'))
    exp.data <- mutate(exp.data, Signif.Prop=ifelse(exp.data[,'P.Value.Prop'] > (1 - input$significance),'N','Y'))
    
    # Flag as better or worse than the control
    exp.data <- mutate(exp.data, Result.Mean=ifelse(exp.data[,'Lift.Mean'] >= input$mean.lift,
                                                    'Above Target',
                                                    ifelse(exp.data[,'Group'] == '.Control',
                                                           'Contol',
                                                           'Below Target'
                                                    )
    ))
    exp.data <- mutate(exp.data, Result.Prop=ifelse(exp.data[,'Lift.Prop'] >= input$prop.lift,
                                                    'Above Target',
                                                    ifelse(exp.data[,'Group'] == '.Control',
                                                           'Contol',
                                                           'Below Target'
                                                    )
    ))
    
    # Which test was the winner?
    exp.data <- mutate(exp.data, Winner.Mean='N')
    a <- value(ab.info)[,'Test'] == input$ab.test
    if(value(ab.info)[a,'Type'] == 'M'){
      a <- exp.data[,'Pct.Mean.Grtr.CX'] == max(exp.data[,'Pct.Mean.Grtr.CX'])
      exp.data[a,'Winner.Mean'] <- 'Y'
    } 
    
    exp.data <- mutate(exp.data, Winner.Prop='N')
    a <- exp.data[,'Pct.Prop.Grtr.CX'] == max(exp.data[,'Pct.Prop.Grtr.CX'])
    exp.data[a,'Winner.Prop'] <- 'Y'
    
    # Blank out some of the Control Cell's values
    #     a <- exp.data[,'Group'] == '.Control'
    #     exp.data[a,'P.Value.Prop'] <- NA
    #     exp.data[a,'P.Value.Mean'] <- NA
    #     exp.data[a,'Lift.Prop'] <- NA
    #     exp.data[a,'Lift.Mean'] <- NA
    #     exp.data[a,'SD.Sample.Mean.Diff'] <- NA
    #     #exp.data[a,'SD.Sample.Means'] <- NA
    #     exp.data[a,'SD.Prop.Diff'] <- NA
    #     exp.data[a,'Signif.Mean'] <- ' '
    #     exp.data[a,'Signif.Prop'] <- ' '
    
    # remove temporary variables
    rm(tmp)
    rm(a)
    rm(b)
    rm(n)
    exp.data
  })
  
  # Return a subset of columns for the experiment and the winning flags
  output$summary.mean <- reactiveTable(function(){
    a <- value(ab.info)[,'Test'] == input$ab.test
    if(value(ab.info)[a,'Type'] == 'M'){
      # grab a sub set of the results for summary purposes
      b <- c('Group','Size','Mean','Lift.Mean','Signif.Mean','Result.Mean')
      c <- results()
      c[,b]
    }
  })
  output$summary.prop <- reactiveTable(function(){
    # grab a sub set of the results for summary purposes
    a <- c('Group','Size','Acted','Prop','Lift.Prop','Signif.Prop','Result.Prop')
    b <- results()
    b[,a]
  })
  
  # Plot the mean/prop performance of each cell in the experiment
  output$cell.plot.mean <- reactivePlot(function(){
    a <- value(ab.info)[,'Test'] == input$ab.test
    if(value(ab.info)[a,'Type'] == 'M'){
      b <- results()
      plot.1 <- ggplot(b, aes(x=Group,y=Mean,  color=Result.Mean)) +
        geom_errorbar(aes(ymin=Lower.Mean,ymax=Upper.Mean),color='black', width=.1) +
        geom_point(size=6)+
        scale_fill_manual(values=my.palette) +
        scale_colour_manual(values=my.palette)
      print(plot.1)
    }
  })
  output$cell.plot.prop <- reactivePlot(function(){
    a <- results()
    plot.1 <- ggplot(a, aes(x=Group,y=Prop,  color=Result.Prop)) +
      geom_errorbar(aes(ymin=Lower.Prop,ymax=Upper.Prop),color='black', width=.1) +
      geom_point(size=6)+
      scale_fill_manual(values=my.palette) +
      scale_colour_manual(values=my.palette)
    print(plot.1)
  })
  
  # Return a subset of the columns for the experiment, for only the control and winner
  output$winner.mean <- reactiveTable(function(){
    a <- value(ab.info)[,'Test'] == input$ab.test
    if(value(ab.info)[a,'Type'] == 'M'){
      # grab a sub set of the results for summary purposes
      b <- c('Group','Size','Mean','Lift.Mean','Pct.Mean.Grtr.C','Pct.Mean.Grtr.CX','Winner.Mean')
      c <- results()
      c[,b]
    }
  })
  output$winner.prop <- reactiveTable(function(){
    # grab a sub set of the results for summary purposes
    a <- c('Group','Size','Acted','Prop','Lift.Prop','Pct.Prop.Grtr.C','Pct.Prop.Grtr.CX','Winner.Prop')
    b <- results()
    b[,a]
  })
  
  # plot the distributions of the control cell and the winning cell
  output$distro.plot.mean <- reactivePlot(function(){
    a <- value(ab.info)[,'Test'] == input$ab.test
    if(value(ab.info)[a,'Type'] == 'M'){
      b <- results()
      c <- b[,'Group'] == '.Control'
      d <- with(density(rnorm(n=1000,mean=b[c,'Mean'],sd=b[c,'SD.Sample.Means'])),data.frame(x,y))
      e <- b[c,'Mean'] + input$mean.lift
      f <- b[c,'Mean']
      g <- b[,'Winner.Mean'] == 'Y'
      h <- with(density(rnorm(n=1000,mean=b[g,'Mean'],sd=b[g,'SD.Sample.Means'])),data.frame(x,y))
      i <- b[g,'Mean']
      plot.2 <- ggplot(data = d, mapping = aes(x = x, y = y), environment = environment()) +
        geom_line(color="#00A5FF") + 
        geom_line(data = h, aes(x = x, y = y),color="#00B81E") +
        layer(data = d, mapping = aes(x=ifelse(x > e,x,e), y=y), geom = "area", geom_params=list(fill="#00A5FF",alpha=.3)) +
        layer(data = h, mapping = aes(x=ifelse(x > e,x,e), y=y), geom = "area", geom_params=list(fill="#00B81E",alpha=.3)) + 
        scale_y_continuous(limits = c(0,max(d$y,h$y)), name="Density") + 
        scale_x_continuous(name="Mean") +
        geom_vline(aes(xintercept=e), color="red", linetype="dashed") +
        geom_vline(aes(xintercept=f), color="#00A5FF", linetype="dashed")
      geom_vline(aes(xintercept=i), color="#00B81E", linetype="dashed")
      print(plot.2)
    }
  })
  output$distro.plot.prop <- reactivePlot(function(){
    b <- results()
    c <- b[,'Group'] == '.Control'
    d <- with(density(rnorm(n=1000,mean=b[c,'Prop'],sd=b[c,'SD.Prop'])),data.frame(x,y))
    e <- b[c,'Prop'] + input$prop.lift
    f <- b[c,'Prop']
    g <- b[,'Winner.Prop'] == 'Y'
    h <- with(density(rnorm(n=1000,mean=b[g,'Prop'],sd=b[g,'SD.Prop'])),data.frame(x,y))
    i <- b[g,'Prop']
    plot.2 <- ggplot(data = d, mapping = aes(x = x, y = y), environment = environment()) +
      geom_line(color="#00A5FF") + 
      geom_line(data = h, aes(x = x, y = y),color="#00B81E") +
      layer(data = d, mapping = aes(x=ifelse(x > e,x,e), y=y), geom = "area", geom_params=list(fill="#00A5FF",alpha=.3)) +
      layer(data = h, mapping = aes(x=ifelse(x > e,x,e), y=y), geom = "area", geom_params=list(fill="#00B81E",alpha=.3)) + 
      scale_y_continuous(limits = c(0,max(d$y,h$y)), name="Density") + 
      scale_x_continuous(name="Proportion") +
      geom_vline(aes(xintercept=e), color="red", linetype="dashed") +
      geom_vline(aes(xintercept=f), color="#00A5FF", linetype="dashed") +
      geom_vline(aes(xintercept=i), color="#00B81E", linetype="dashed")
    print(plot.2)
  })
  
  # Return a subset of the columns comparing the performance of the various test cells against each other
  # Number of comparisons, is dependent on the number of cells in the test
  # a 50% or 0.50 result, means that differences between cells is as good as CHANCE (less, is worse than chance, more is better than chance)
  output$cell.comparisons.mean <- reactiveTable(function(){
    a <- value(ab.info)[,'Test'] == input$ab.test
    if(value(ab.info)[a,'Type'] == 'M'){
      b <- c('Group','Winner.Prop')
      c <- results()
      for(i in 1:(length(c[,'Group'])-1)){
        d <- paste('Cell',i,sep='')
        e <- c[,'Group'] == d
        f <- c[e,'Lift.Mean']
        g <- paste('Pct.Better.',d,sep='')
        b <- c(b,g)
        c <- mutate(c, g = pnorm(Lift.Mean, f, SD.Sample.Mean.Diff,lower.tail=TRUE))
        names(c)[length(names(c))] <- g
      }
      
      c[,b]
    }
  })
  output$cell.comparisons.prop <- reactiveTable(function(){
    b <- c('Group','Winner.Prop')
    c <- results()
    for(i in 1:(length(c[,'Group'])-1)){
      d <- paste('Cell',i,sep='')
      e <- c[,'Group'] == d
      f <- c[e,'Lift.Prop']
      g <- paste('.Pct.Better.',d,sep='')
      b <- c(b,g)
      c <- mutate(c, g = pnorm(Lift.Prop, f, SD.Prop.Diff,lower.tail=TRUE))
      names(c)[length(names(c))] <- g
    }
    c[,b]
  })
})

testdata.csv

testinfo.csv

ui.R

###############################################
##
##    Attempt no 2 at building a shiny web app
##    for AB Testing use - using global.R
##
##    ui.R - User interface defintion
##
###############################################


# required libraries
require(shiny)
# the following is needed for the action button and is installed via
# library(devtools); install_github('shiny-incubator', 'rstudio')
require(shinyIncubator)

# Define the page layout
###############################################
##
##    Attempt no 2 at building a shiny web app
##    for AB Testing use - using global.R
##
##    ui.R - User interface defintion
##
###############################################


# required libraries
# requires the master version of shiny (1/14/2013), not curren CRAN version - install with
# install.packages('devtools')
# devtools::install_github('shiny', 'rstudio')
require(shiny)
# the following is needed for the action button and is installed via
# library(devtools); install_github('shiny-incubator', 'rstudio')
require(shinyIncubator)

# Define the page layout
shinyUI(pageWithSidebar(
  
  # Web page title area
  headerPanel("AB Testing - Alpha 2"),
  
  # Side panel for controls
  sidebarPanel(
    
    # This forms a drop down and links display elements and values into a variable that is passed from ui.r to server.r
    selectInput('ab.test','Select AB Test:',
                list('Test 1 Name' = 't1',
                     'Test 2 Name' = 't2')),
    br(),
    
    conditionalPanel(# display a reload button, if the data is more than a day old
      condition = "output.dataAge > 1",
      br(),
      "No data for yesterday", br(),
      "Last refresh: ", htmlOutput("last.refresh"), br(),
      "Would you like to try and refresh?  ", actionButton("check.for.data", "Yes"), br(), br()
    ),
    
    sliderInput('significance',"Desired level of significance:", 
                # define the range, step and default of the slider
                min = 0.85, max = 0.99, value = 0.95, step = 0.01),
    "This sldier sets the level of statistical significance desired for the experiment",
    br(),
    br(),
    
    conditionalPanel( # only display this slider if the test is a mean comparison
      condition = "output.mean",
      # Slider input for defining thresholds of MEAN comparisons tests
      sliderInput('mean.lift',"Desired MEAN lift:", 
                  # define the range, step and default of the slider
                  min = 0, max = 3, value = 0.25, step = 0.25),
      "This slider ony applies to mean comparisons only. Setting the desired increase in the mean number of actions taken by subjects in the context of the experiment.",
      br(),
      br()
    ),
    
    # Slider input for defining thresholds of PROPORTION comparisons tests
    sliderInput('prop.lift',"Desired PROPORTION lift:", 
                # define the range, step and default of the slider
                min = 0, max = 0.03, value = 0.001, step = 0.001,
                # add a customer format
                format="#.#%"),
    
    "This slider applies to both mean comparisons and proportional comparisons. Setting the desired increase in the proportion of subjects taking the desired action in the context of the experiment. When applying to mean comparisons, it considers the number of subjects who took at least one action with respect to the experiment, NOT how many actions they took."
    
  ),
  
  
  # Main display panel for results
  mainPanel(
    h2(textOutput("caption")),  #title
    br(),
    (textOutput("desc")),  #title
    br(),
    tabsetPanel(
      tabPanel("Test Summary",
               h4("Summary of comparison test cells to the control"),
               "Color indicates if a test cell has ",
               strong("exceeded"),
               "the target of control + desired lift",
               conditionalPanel( # only display if the test is a mean comparison
                 condition = "output.mean",
                 h4("Summary: Mean"),
                 br(),
                 tableOutput("summary.mean"),# initial mean comparison summary table
                 h6("Means, with 95% confidence intervals"),
                 plotOutput("cell.plot.mean"),
                 br(),
                 br()
               ),  
               h4("Summary: Proportion"),
               tableOutput("summary.prop"),  # initial prop comparison summary table
               h6("Proprtions, with 95% confidence intervals"),
               br(),
               plotOutput("cell.plot.prop")
      ),  # high level plot of all test cells
      tabPanel("Overall Winner",
               h4("Percentage of test cell distributions exceeding control mean and target"),
               "Colored area illustrates the percentage of randon samples that experience either the control or winning test cell treatment, would actually exceed the target control + desired lift",
               br(),
               br(),
               conditionalPanel( # only display if the test is a mean comparison
                 condition = "output.mean",
                 h4("Winner and Distributions: Means"),
                 br(),
                 tableOutput("winner.mean"),
                 plotOutput("distro.plot.mean"),
                 br(),
                 br()
               ),
               h4("Winner and Distributions: Proportions"),
               br(),
               tableOutput("winner.prop"),
               plotOutput("distro.plot.prop")
      ),
      tabPanel("Cell to Cell Comparisons",
               h4("Cell-to-cell comparisons - is the winner, really the winner?"),
               br(),
               "The winning cell, when compared to all other cells, will ideally differ from those otherc ells by more than 0.50. A value of 0.50 means that any difference between two cells is due to chance and they are basically indistinguishable",
               br(),
               br(),
               conditionalPanel( # only display if the test is a mean comparison
                 condition = "output.mean",
                 h4("Cell-to-cell: Means"),
                 br(),
                 tableOutput("cell.comparisons.mean"),
                 br(),
                 br()
               ),
               h4("Cell-to-cell: Proportions"),
               br(),
               tableOutput("cell.comparisons.prop")
      )
    )
  )
)
)