forked from alphanumerritt/abtestanalysis
-
Notifications
You must be signed in to change notification settings - Fork 0
/
abTestResults.Rmd
519 lines (445 loc) · 17.7 KB
/
abTestResults.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
---
title: "Experimentation Tools"
output:
flexdashboard::flex_dashboard:
orientation: rows
css: styles.css
vertical_layout: scroll
logo: logo-sm.png
favicon: favicon.png
fig_height: 1
navbar:
- { title: "Sequential App", href: "https://sdidev.shinyapps.io/sequential-test-calculator/" }
- { title: "Sample Size", href: "https://sdidev.shinyapps.io/sample-size-calculator/" }
- { title: "Runtime", href: "https://sdidev.shinyapps.io/sample-size-calculator-runtime/" }
- { title: "Impact Simulation", href: "https://sdidev.shinyapps.io/test-result-simulator/" }
- { title: "Experimentation ROI", "href:https://sdidev.shinyapps.io/experimentation-roi/" }
runtime: shiny
---
```{r setup, include=FALSE}
library(ggplot2)
library(shiny)
library(gt)
library(tidyr)
library(dplyr)
library(scales)
library(capture)
# Default images placed in reactive variable
img1a = base64enc::dataURI(file = "placeholderImageA.png", mime = "image/png")
img1b = base64enc::dataURI(file = "placeholderImageB.png", mime = "image/png")
reactiveImages <- reactiveValues(imgA = img1a, imgB = img1b)
# SDI colors are
# Light Orange: F58220
# Orange:FF6D00
# Dark Orange: E45C00
# Light Teal: 00A2B1
# Teal: 00747F
# Dark Teal: 004E54
# Dark Gray: 515151
# Light Gray: 9A9896
```
<script>
$('.navbar-logo').wrap('<a href="https://www.searchdiscovery.com/how-we-help/services/optimization/" target=_blank>');
</script>
<div style="display: none;">
```{r url_bookmarking}
# The code below uses query parameters in the URL of the page so that the total configuration
# is captured in the URL, enabling someone to "come back" to the exact configuration at any point.
# See details at: https://shiny.rstudio.com/reference/shiny/1.5.0/updateQueryString.html.
# And at https://shiny.rstudio.com/articles/bookmarking-state.html
# This chunk is wrapped in a <div> that sets the display to none because, otherwise, a little
# bit of JS gets rendered that chunk options are unable to turn off.
enableBookmarking("url")
setBookmarkExclude(c("imgA", "imgB", "hypo"))
observe({
# Trigger this observer every time an input changes
reactiveValuesToList(input)
session$doBookmark()
})
onBookmarked(function(url) {
updateQueryString(url)
})
```
</div>
```{r binomialcalculations, include=FALSE}
# Declare reactive variables to hold all results for use throughout
rctRslts <- reactiveValues(pv = NULL, cl = NULL, upa = NULL, upb = NULL, upd = NULL, loa = NULL, lob = NULL, lod = NULL, diff = NULL, seDif = NULL, z = NULL)
# Main event observer to listen for input changes and to calculate main results
observeEvent(c(input$cva, input$cvb, input$traffa, input$traffb, input$confinterval, input$tails, input$nonf, input$bonf), {
# Don't execut unless traffic inputs are greater than conversion inputs
req(input$traffa > input$cva)
req(input$traffb > input$cvb)
req(input$cva > 0)
req(input$cvb > 0)
ca <- input$cva
cb <- input$cvb
ta <- input$traffa
tb <- input$traffb
cvra <- ca/ta
cvrb <- cb/tb
reldiff <- cvrb/cvra-1
SEa <- sqrt((cvra*(1-cvra))/ta)
SEb <- sqrt((cvrb*(1-cvrb))/tb)
SEdiff <- sqrt(SEa^2 + SEb^2)
ci <- input$confinterval/100
ciZ <- abs(qnorm((1-ci)/2))
cila <- cvra - SEa * ciZ
ciua <- cvra + SEa * ciZ
cilb <- cvrb - SEb * ciZ
ciub <- cvrb + SEb * ciZ
cild <- ((cvrb - cvra) - SEdiff * ciZ)/cvra
ciud <- ((cvrb - cvra) + SEdiff * ciZ)/cvra
z <- (cvrb - cvra) / SEdiff
pval <- (1-pnorm(abs(z))) * input$tails
pval <- p.adjust(pval, method = "bonferroni", n = input$bonf)
conf <- 1-pval
testpower <- power.prop.test(n = (input$traffa + input$traffb)/2, p1 = cvra, p2 = cvrb, sig.level = 1 - ci, alternative = ifelse(input$tails < 2, "one", "two"))
# Dump all the values into the reactive variables
rctRslts$pv <- pval
rctRslts$cl <- conf
rctRslts$upa <- ciua
rctRslts$upb <- ciub
rctRslts$upd <- ciud
rctRslts$loa <- cila
rctRslts$lob <- cilb
rctRslts$lod <- cild
rctRslts$diff <- reldiff
rctRslts$seDif <- SEdiff
rctRslts$SEa <- SEa
rctRslts$SEb <- SEb
rctRslts$cvra <- cvra
rctRslts$cvrb <- cvrb
rctRslts$z <- z
rctRslts$pwr <- testpower$power
})
```
Sidebar {.sidebar data-width=270}
=====================================
```{r inputs}
inputPanel(
h4("Control Variation"),
numericInput("cva", label = "Control Conversions", value = 890, min = 0),
numericInput("traffa", label = "Control Traffic", value = 10000, min = 0)
)
inputPanel(
h4("Test Variation"),
numericInput("cvb", label = "Test Conversions", value = 920, min = 0),
numericInput("traffb", label = "Test Traffic", value = 10000, min = 0)
)
```
```{r configinputs}
inputPanel(
h4("Test Configuration Inputs"),
numericInput("confinterval", label = "Statistical significance threshold (a %, also used for confidence intervals)", value = 95, min = 50, max = 99),
numericInput("tails", label = "How many tails?", value = 1, min = 1, max = 2),
#numericInput("nonf", label = "Non-inferiority margin (if applicable)", value = 0, min = 0, max = 100),
numericInput("bonf", label = "Total p-values being calculated (applies Bonferroni correction)", value = 1, min = 1, max = 99)
)
```
```{r revinputs}
inputPanel(
h4("Revenue Projection Inputs"),
numericInput("convValue", label = "What's the approximate value of a conversion?", value = 10, min = 0, max = 10000000),
numericInput("convVolume", label = "About how many conversions per month does the test audience provide?", value = 1000, min = 1, max = 10000000)
)
```
```{r custominputs}
inputPanel(
h4("Customize Test Details"),
textInput("testname", label = "Name of test for report label", value = "A/B Test Results"),
textInput("expA", label = "Label for Control Variation", value = "A"),
textInput("expB", label = "Label for Test Variation", value = "B"),
textInput("hypo", label = "Test hypothesis", value = "Test Hypothesis: If [this] then [that will happen] because [we have evidence]."),
fileInput("imgA", "Screenshot Control", accept = c('image/png', 'image/jpeg')),
fileInput("imgB", "Screenshot Test", accept = c('image/png', 'image/jpeg'))
)
inputPanel(
h4("Customize Colors"),
textInput("hexa", label = "Custom hex color code for A", value = "#FF6D00"),
textInput("hexb", label = "Custom hex color code for B", value = "#00A2B1"),
textInput("hexd", label = "Custom hex color code for other charts", value = "#515151")
)
```
```{r pdfexport}
# EXPORT TO PDF
# Package from github: remotes::install_github("dreamRs/capture")
renderUI({
div(id="exportpdf",
capture::capture_pdf(
selector = ".level1",
filename = "abTestResults",
icon("download"), "Export to PDF",
margin = 2
)
)
})
```
Test Analysis <!-- {data-icon="fa-percentage"} -->
=====================================
Row {.topRow}
-----------------------------------------------------------------------
```{r resultsHeader}
output$testheader <- renderUI({
div(
div(
h1(id = "testTitle", paste0(input$testname))
),
div(id = "hypothesis",
p(paste0(input$hypo))),
div(id = "imagesboth",
div(id = "ssA",
img(src = reactiveImages$imgA)
),
div(id = "ssB",
img(src = reactiveImages$imgB)
)
)
)
})
observeEvent(input$imgA, {
req(is.null(input$imgA)==FALSE)
reactiveImages$imgA = base64enc::dataURI(file = input$imgA$datapath, mime = "image/png")
})
observeEvent(input$imgB, {
req(is.null(input$imgB)==FALSE)
reactiveImages$imgB = base64enc::dataURI(file = input$imgB$datapath, mime = "image/png")
})
uiOutput("testheader", class = "testmeta")
```
Row {data-height=350}
-----------------------------------------------------------------------
### Key Results
```{r keyResults}
renderUI({
colora <- paste0("color:",input$hexa)
colorb <- paste0("color:",input$hexb)
colord <- paste0("color:",ifelse(rctRslts$cvrb>rctRslts$cvra,input$hexb,input$hexa))
div(id = "resultsContainer", # outer shell
div(id = "resultsRow1", # row with variant names
div(id = "resultsRow1Cell1", style = colora,
input$expA
),
div(id = "resultsRow1Cell2", style = colorb,
input$expB
)
),
div(id = "resultsRow2", # row with conversion rates
div(id = "resultsRow2Cell1",
paste0(round(rctRslts$cvra*100,1),"%")
),
div(id = "resultsRow2Cell2",
paste0(round(rctRslts$cvrb*100,1),"%")
)
),
div(id = "resultsRow3", style = colord, # row with conversion difference
paste0(round(rctRslts$diff*100,1),"%")
),
div(id = "resultsRow4", # word
"difference"
),
div(id = "resultsRow5", # row with stat sig
paste0(round(rctRslts$cl*100,1),"% statistical significance")
),
div(id = "resultsRow6", # row with result determination
if (rctRslts$cl*100 > input$confinterval) "This result is statistically significant. The test is conclusive."
else "This result is not statistically significant. The test is inconclusive."
)
)
})
```
### Confidence Interval of Difference
```{r diffConfidenceInterval}
rmarkdown::render_delayed({
renderPlot({
sims <- 10000 # how many simulations of conversion rate for chart
ptDiff <- rctRslts$cvrb - rctRslts$cvra # raw effect
# simulate effect sizes with observed effect as mean and SEdiff as sd
df <- data.frame(Effect = rnorm(n = sims, mean = ptDiff, sd = rctRslts$seDif)) %>%
mutate(relEffect = Effect/rctRslts$cvra) # make simulated effects relative to control cvr
# plot the distribution
ggplot(df, aes(x = relEffect)) +
geom_density(aes(y=..scaled..), alpha = .2, bw = "SJ", adjust = 2, fill = input$hexd) +
labs(x="True difference in conversion rates", y="Likelihood") +
scale_x_continuous(labels = scales::percent) +
scale_y_continuous(expand = c(0, 0), limits = c(0,1.2)) + # this fixes spacing around plot
geom_vline(xintercept = c(rctRslts$lod,rctRslts$upd,rctRslts$diff), linetype = "dashed", size = .25, color = input$hexd) +
annotate(geom="text", x= c(rctRslts$lod,rctRslts$upd,rctRslts$diff),
y=.5,
label= c( # line labels
paste0(round(rctRslts$lod*100,1),"%"),
paste0(round(rctRslts$upd*100,1),"%"),
paste0(round(rctRslts$diff*100,1),"%")),
fontface = "bold",
angle = 90,
size = 4.0) +
theme_light() +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank()) # removes unnecessary elements
})
})
```
Row Row {data-height=350}
-----------------------------------------------------------------------
### Calculations
```{r fullStats}
render_gt({
# create data frame of all the pertinent data
df <- data.frame(
Metric = c(
"Conversion Rate A",
"Conversion Rate B",
"Difference (relative)",
"Difference (pts.)",
"Standard Error A",
"Standard Error B",
"Standard Error Difference",
"Z-score",
"P-value",
"Statistical Significance",
"Power"
),
Lower = c(
rctRslts$loa,
rctRslts$lob,
rctRslts$lod,
rctRslts$lod*rctRslts$cvra,
NA,NA,NA,NA,NA,NA,NA
),
Observed = c(
rctRslts$cvra,
rctRslts$cvrb,
rctRslts$diff,
rctRslts$diff*rctRslts$cvra,
rctRslts$SEa,
rctRslts$SEb,
rctRslts$seDif,
rctRslts$z,
rctRslts$pv,
rctRslts$cl,
rctRslts$pwr
),
Upper = c(
rctRslts$upa,
rctRslts$upb,
rctRslts$upd,
rctRslts$upd*rctRslts$cvra,
NA,NA,NA,NA,NA,NA,NA
)
)
# put the data frame in a nice table format
gt(df) %>%
fmt_percent(columns=vars(Lower,Observed,Upper), rows=c(1:3,10,11), decimals = 1) %>%
fmt_number(columns=vars(Lower,Observed,Upper), rows=c(4:9), decimals = 4) %>%
cols_align(align = "left", columns = vars(Metric)) %>%
cols_align(align = "center", columns = vars(Lower, Observed, Upper)) %>%
cols_label(Metric = "Measure") %>%
fmt_missing(columns=vars(Lower,Observed,Upper), rows = NULL, missing_text = " ") %>% # any NA values leave blanks
tab_options(table.width = pct(100))
}, align = "center")
```
### Confidence Intervals of Conversion Rates
```{r conversionRatesIntervals}
rmarkdown::render_delayed({
renderPlot({
sims <- 10000 # how many simulations of conversion rate for chart
# create data frame of simulated conversion rates based on observed CVRs and standard errors
df <- data.frame(
variant = factor(c(rep("A", sims),rep("B", sims))),
CVR = c(rnorm(n = sims, mean = rctRslts$cvra, sd = rctRslts$SEa), rnorm(n = sims, mean = rctRslts$cvrb, sd = rctRslts$SEb)))
# plot the distributions
ggplot(df, aes(x = CVR)) +
geom_density(aes(y=..scaled.., fill = variant), alpha = .5, bw = "SJ", adjust = 3) +
scale_fill_manual(values = c(input$hexa,input$hexb)) + # pull in colors from inputs
labs(x="True Conversion Rate", y="Likelihood") +
scale_x_continuous(labels = scales::percent) +
scale_y_continuous(expand = c(0, 0), limits = c(0,1.2)) + # this fixes spacing around plot
geom_vline(
xintercept = c(
rctRslts$loa,
rctRslts$upa,
rctRslts$cvra,
rctRslts$lob,
rctRslts$upb,
rctRslts$cvrb
),
linetype = "dashed",
size = .25,
color = c(input$hexa, input$hexa,input$hexa, input$hexb,input$hexb,input$hexb) # colors lines with custom colors from inputs
) +
annotate(geom="text", x= c(rctRslts$loa,rctRslts$lob,rctRslts$cvra,rctRslts$cvrb,rctRslts$upa,rctRslts$upb), # adds line labels
y = c(.2,.5,.2,.5,.2,.5),
vjust = "center", # > +0.1 range pushes the text annotation down vertically
label= c(
paste0(round(rctRslts$loa*100,1),"%"),
paste0(round(rctRslts$lob*100,1),"%"),
paste0(round(rctRslts$cvra*100,1),"%"),
paste0(round(rctRslts$cvrb*100,1),"%"),
paste0(round(rctRslts$upa*100,1),"%"),
paste0(round(rctRslts$upb*100,1),"%")),
fontface = "bold",
angle = 90,
size = 4.0) +
annotate(geom="text", # adds variant labels from inputs
x= c(rctRslts$cvra,rctRslts$cvrb),
y = 1.1,
hjust = "center",
label= c(input$expA,input$expB),
fontface = "bold",
size = 4.0) +
annotate(geom="pointrange", # adds interval lines
x = c(rctRslts$cvra,rctRslts$cvrb),
y = c(.1,.4),
xmin = c(rctRslts$loa,rctRslts$lob),
xmax = c(rctRslts$upa,rctRslts$upb),
#vjust = c(-3,-3.5),
size = .75,
shape = 18) +
theme_light() +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), axis.text.y = element_blank(), legend.position = "none", axis.ticks.y = element_blank()) # gets rid of unnecessary elements
})
})
```
Row {data-height=350}
-----------------------------------------------------------------------
### 6 Month Revenue Projections
```{r revprojections}
rmarkdown::render_delayed({
renderPlot({
sims <- 10000 # how many simulations of the difference to make
ptDiff <- rctRslts$cvrb - rctRslts$cvra # raw effect size to simulate a random distribution from
revMult <- input$convVolume * input$convValue * 6
revMult2 <- revMult * rctRslts$cvra # what to multiply each difference by
ciLines <- c(rctRslts$lod,rctRslts$upd,rctRslts$diff) * rctRslts$cvra * input$convVolume * input$convValue * 6 # placement of lines
revout <- dollar_format(largest_with_cents = 9, negative_parens = TRUE) # function to set dollar formats for labels
# compile text labels
lolabel <- paste0(trunc(100-(100-input$confinterval)/2),"% chance of contributing at least ",revout(rctRslts$lod*revMult2))
uplabel <- paste0(trunc((100-input$confinterval)/2),"% chance of contributing at least ",revout(rctRslts$upd*revMult2))
ciLabels <- c(lolabel,uplabel,"")
# simulat effect sizes then multiply them by conversions and value
df <- data.frame(Effect = rnorm(n = sims, mean = ptDiff, sd = rctRslts$seDif)) %>%
mutate(revIncrease = Effect * revMult)
# plot the distributions
ggplot(df, aes(x = revIncrease)) +
geom_density(aes(y= 1 - ..y..), alpha = .2, stat = "ecdf", fill = input$hexd) +
labs(x="Expected minimum value contribution", y="Likelihood") +
scale_x_continuous(expand = c(0, 0), limits = c(NA,NA),labels = scales::dollar) +
scale_y_continuous(expand = c(0, 0), limits = c(0,1.05), labels = scales::percent) +
geom_vline(xintercept = ciLines, linetype = "dashed", size = .25, color = "#515151") +
annotate(geom="text", x= ciLines,
y=.5,
label= ciLabels,
fontface = "bold",
angle = 90,
size = 4) +
theme_light()
})
})
```
### Notes
The revenue projections are based on the confidence interval around the difference in conversion rates. These probabilities are applied, without any decay rate, to 6 months of conversion volume at the value provided. The chart shows the cumulative probability of achieving at least a certain value, even if negative.
Predicting revenue impact is tricky and we recommend extreme caution before booking any upside with the finance team. In fact, [we made a whole simulator](https://sdidev.shinyapps.io/test-result-simulator/){target="_blank"} to illustrate why.
Row {data-height=50}
-----------------------------------------------------------------------
version 1.6
To see version history, report bugs and submit feature requests [click here](https://github.com/alphanumerritt/abtestanalysis/issues){target="_blank"}.
<!-- Continuous Metric {data-icon="fa-sort-numeric-down"} -->
<!-- ===================================== -->