Skip to content

Instantly share code, notes, and snippets.

@rcquan
Forked from dempseydata/global.R
Last active September 15, 2015 08:09
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save rcquan/a8140dc8be9bb2c6a563 to your computer and use it in GitHub Desktop.
Save rcquan/a8140dc8be9bb2c6a563 to your computer and use it in GitHub Desktop.
AB Test Alpha 2
###############################################
##
## 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)))))
###############################################
##
## 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]
})
})
Test Group Size Acted Mean Prop SD.Sample
t1 .Control 3012 2500 9.13 0.83000 9.13
t1 Cell1 2966 2600 9.74 0.87700 9.74
t1 Cell2 3022 2500 8.85 0.82700 8.85
t2 .Control 50000 1500 0.03000
t2 Cell1 50000 1600 0.03200
t2 Cell2 50000 1598 0.03196
t2 Cell3 50000 1605 0.03210
t2 Cell4 50000 1580 0.03160
Test Type Desc Start.Date Last.Date
t1 M Test 1 - changing the search algorithm 2012-12-12 2013-01-10
t2 P Test 2 - trying different upgrade button locations 2012-12-12 2013-01-10
###############################################
##
## 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")
)
)
)
)
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment