Nothing
library(shiny)
library(shinyBS)
library(shinycssloaders)
library(DT)
library(tidyverse)
library(stringr)
library(clusterPower)
source("labels.R")
source("helpers.R")
source("builders.R")
# vectors of names, needed for graphs and target param selection
names2mean <- c("alpha","power","nclusters","nsubjects","sigma_sq","sigma_b_sq","CV","d","ICC","vart","method")
names2meanD <- c("alpha","power","nclusters","nsubjects","d","ICC","rho_c","rho_s","vart")
names2meanM <- c("alpha","power","nclusters","nsubjects","d","icc","vart","rho_m")
namesnmean <- c("alpha","power","narms","nclusters","nsubjects","vara","varc","vare")
namesSW <- c("alpha","power","nclusters","nsubjects","ntimes","d", "icc", "rho_c","rho_s","vart")
names2prop <- c("alpha","power","nclusters","nsubjects","cv","p1","p2","ICC","pooled","p1inc","ttest")
names2propD <- c("alpha","power","nclusters","nsubjects","p","d","ICC","rho_c","rho_s")
names2propM <- c("alpha","power","nclusters","nsubjects","p1","p2","cvm","p1inc")
names2rate <- c("alpha","power","nclusters","py","r1","r2","CVB","r1inc")
umass <- "font-family: 'Open Sans', Helvetica, Arial, sans-serif; font-weight: bold; color: #ffffff; background-color: #881c1c; border: 3px solid #000000;"
ui <- function(request){
fluidPage(
HTML("<h3>Simple Two-Arm Designs</h3>
<p>To use the two-arm calculator, leave the desired quantity blank and enter values for the other quantities.</p>
<p>You may specify more than one input quantity by separating numbers with spaces or commas.<p>
<p>You may specify a sequence of values by typing 'X to Y by Z', where 'X' is the starting value, 'Y' is the ending value, and 'Z' is the increment.</p>"),
HTML("This Beta has minimal documentation; please contact ken.kleinman@gmail.com with any feedback."),
column(12, bookmarkButton("Save App State")),
tabsetPanel(
#-----------------------------------------------------------------------------------------------------------
tabPanel("Continuous",
column(2,
#----------------------------------------------------------
fluidRow(textInput("alpha2mean", alphatext,
value = "0.05", width = "100%")),
bsTooltip("alpha2mean", alphatooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("power2mean", powertext,
value = "", width = "100%")),
bsTooltip("power2mean", powertooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("d2mean", dtext,
value = "", width = "100%")),
bsTooltip("d2mean", dtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("nclusters2mean", nclusterstext,
value = "", width = "100%")),
bsTooltip("nclusters2mean", nclusterstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("n2mean", nsubjectstext,
value = "", width = "100%")),
bsTooltip("n2mean", nsubjectstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("sigma_sq2mean", sigma_sqtext,
value = "", width = "100%")),
bsTooltip("sigma_sq2mean", sigma_sqtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("sigma_b_sq2mean", sigma_b_sqtext,
value = "", width = "100%")),
bsTooltip("sigma_b_sq2mean", sigma_b_sqtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("icc2mean", icctext,
value = "", width = "100%")),
bsTooltip("icc2mean", icctooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("vart2mean", varttext,
value = "", width = "100%")),
bsTooltip("vart2mean", varttooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("cv2mean", cvtext,
value = "0", width = "100%")),
bsTooltip("cv2mean", cvtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(checkboxGroupInput("method2mean", methodtext,
choices = c(Taylor = "taylor", Weighted = "weighted"),
selected = "taylor")),
bsTooltip("method2mean", methodtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(
column(6, style='padding:0px;', actionButton("default2mean", defaulttext, width = "100%")),
column(6, style='padding:0px;', actionButton("clear2mean", clearalltext, width = "100%"))
),
fluidRow(
column(12, style='padding: 0px;', actionButton("calc2mean", calctext, width = "100%",
style = umass)),
fluidRow(column(12, credittext))
)
),
column(10,
make_table_and_graph("2mean", names2mean)
) # end column(10,...
), # end tabPanel("Continuous ...
#-----------------------------------------------------------------------------------------------------------
tabPanel("Continuous DID",
column(2,
#----------------------------------------------------------
fluidRow(textInput("alpha2meanD", alphatext,
value = "0.05", width = "100%")),
bsTooltip("alpha2meanD", alphatooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("power2meanD", powertext,
value = "", width = "100%")),
bsTooltip("power2meanD", powertooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("d2meanD", dDtext,
value = "", width = "100%")),
bsTooltip("d2meanD", dDtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("nclusters2meanD", nclusterstext,
value = "", width = "100%")),
bsTooltip("nclusters2meanD", nclusterstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("n2meanD", nsubjectstext,
value = "", width = "100%")),
bsTooltip("n2meanD", nsubjectstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("icc2meanD", icctext,
value = "", width = "100%")),
bsTooltip("icc2meanD", icctooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("rho_c2meanD", rho_ctext,
value = "", width = "100%")),
bsTooltip("rho_c2meanD", rho_ctooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("rho_s2meanD", rho_stext,
value = "", width = "100%")),
bsTooltip("rho_s2meanD", rho_stooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("vart2meanD", varttext,
value = "", width = "100%")),
bsTooltip("vart2meanD", varttooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(
column(6, style='padding:0px;', actionButton("default2meanD", defaulttext, width = "100%")),
column(6, style='padding:0px;', actionButton("clear2meanD", clearalltext, width = "100%"))
),
fluidRow(
column(12, style='padding: 0px;', actionButton("calc2meanD", calctext, width = "100%",
style = umass)),
fluidRow(column(12, credittext))
)
),
column(10,
make_table_and_graph("2meanD", names2meanD)
) # end column(10,...
), # end tabPanel("Continuous DID ...
#-----------------------------------------------------------------------------------------------------------
tabPanel("Stepped Wedge",
column(2,
#----------------------------------------------------------
fluidRow(textInput("alphaSW", alphatext,
value = "0.05", width = "100%")),
bsTooltip("alphaSW", alphatooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("powerSW", powertext,
value = "", width = "100%")),
bsTooltip("powerSW", powertooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("dSW", dtext,
value = "", width = "100%")),
bsTooltip("dSW", dDtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("ntimesSW", ntimestext,
value = "", width = "100%")),
bsTooltip("ntimesSW", ntimestooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("nclustersSW", nclustersSWtext,
value = "", width = "100%")),
bsTooltip("nclustersSW", nclustersSWtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("nsubjectsSW", nsubjectstext,
value = "", width = "100%")),
bsTooltip("nsubjectsSW", nsubjectstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("iccSW", icctext,
value = "", width = "100%")),
bsTooltip("iccSW", icctooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("rho_cSW", rho_cSWtext,
value = "", width = "100%")),
bsTooltip("rho_cSW", rho_ctooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("rho_sSW", rho_sSWtext,
value = "", width = "100%")),
bsTooltip("rho_sSW", rho_stooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("vartSW", varttext,
value = "", width = "100%")),
bsTooltip("vartSW", varttooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(
column(6, style='padding:0px;', actionButton("defaultSW", defaulttext, width = "100%")),
column(6, style='padding:0px;', actionButton("clearSW", clearalltext, width = "100%"))
),
fluidRow(
column(12, style='padding: 0px;', actionButton("calcSW", calctext, width = "100%",
style = umass)),
fluidRow(column(12, credittext))
)
),
column(10,
make_table_and_graph("SW", namesSW)
) # end column(10,...
), # end tabPanel("Continuous DID ...
#-----------------------------------------------------------------------------------------------------------
tabPanel("Continuous Matched",
column(2,
#----------------------------------------------------------
fluidRow(textInput("alpha2meanM", alphatext,
value = "0.05", width = "100%")),
bsTooltip("alpha2meanM", alphatooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("power2meanM", powertext,
value = "", width = "100%")),
bsTooltip("power2meanM", powertooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("d2meanM", dtext,
value = "", width = "100%")),
bsTooltip("d2meanM", dtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("nclusters2meanM", nclusterstext,
value = "", width = "100%")),
bsTooltip("nclusters2meanM", nclusterstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("n2meanM", nsubjectstext,
value = "", width = "100%")),
bsTooltip("n2meanM", nsubjectstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("icc2meanM", icctext,
value = "", width = "100%")),
bsTooltip("icc2meanM", icctooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("rho_m2meanM", rho_mtext,
value = "", width = "100%")),
bsTooltip("rho_m2meanM", rho_mtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("vart2meanM", varttext,
value = "", width = "100%")),
bsTooltip("vart2meanM", varttooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(
column(6, style='padding:0px;', actionButton("default2meanM", defaulttext, width = "100%")),
column(6, style='padding:0px;', actionButton("clear2meanM", clearalltext, width = "100%"))
),
fluidRow(
column(12, style='padding: 0px;', actionButton("calc2meanM", calctext, width = "100%",
style = umass)),
fluidRow(column(12, credittext))
)
),
column(10,
make_table_and_graph("2meanM", names2meanM)
) # end column(10,...
), # end tabPanel("Continuous Matched ...
#-----------------------------------------------------------------------------------------------------------
tabPanel("Continuous Multiarm",
column(2,
#----------------------------------------------------------
fluidRow(textInput("alphanmean", alphatext,
value = "0.05", width = "100%")),
bsTooltip("alphanmean", alphatooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("powernmean", powertext,
value = "", width = "100%")),
bsTooltip("powernmean", powertooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("narmsnmean", narmstext,
value = "", width = "100%")),
bsTooltip("narmsnmean", narmstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("nclustersnmean", nclusterstext,
value = "", width = "100%")),
bsTooltip("nclustersnmean", nclusterstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("nnmean", nsubjectstext,
value = "", width = "100%")),
bsTooltip("nnmean", nsubjectstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("varanmean", varatext,
value = "", width = "100%")),
bsTooltip("varanmean", varatooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("varcnmean", varctext,
value = "", width = "100%")),
bsTooltip("varcnmean", varctooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("varenmean", varetext,
value = "", width = "100%")),
bsTooltip("varenmean", varetooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(
column(6, style='padding:0px;', actionButton("defaultnmean", defaulttext, width = "100%")),
column(6, style='padding:0px;', actionButton("clearnmean", clearalltext, width = "100%"))
),
fluidRow(
column(12, style='padding: 0px;', actionButton("calcnmean", calctext, width = "100%",
style = umass)),
fluidRow(column(12, credittext))
)
),
column(10,
make_table_and_graph("nmean", namesnmean)
) # end column(10,...
), # end tabPanel("Continuous ...
#-----------------------------------------------------------------------------------------------------------
tabPanel("Binary",
column(2,
#----------------------------------------------------------
fluidRow(textInput("alpha2prop", alphatext,
value = "0.05", width = "100%")),
bsTooltip("alpha2prop", alphatooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("power2prop", powertext,
value = "", width = "100%")),
bsTooltip("power2prop", powertooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("p12prop", p1text,
value = "", width = "100%")),
bsTooltip("p12prop", p1tooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("p22prop", p2text,
value = "", width = "100%")),
bsTooltip("p22prop", p2tooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(checkboxInput("p1inc2prop", p1inctext)),
bsTooltip("p1inc2prop", p1inctooltip,
'top', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(checkboxInput("pooled2prop", pooledtext)),
bsTooltip("pooled2prop", pooledtooltip,
'top', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(checkboxInput("ttest2prop", ttesttext)),
bsTooltip("ttest2prop", ttesttooltip,
'top', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("nclusters2prop", nclusterstext,
value = "", width = "100%")),
bsTooltip("nclusters2prop", nclusterstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("n2prop", nsubjectstext,
value = "", width = "100%")),
bsTooltip("n2prop", nsubjectstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("icc2prop", icctext,
value = "", width = "100%")),
bsTooltip("icc2prop", icctooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("cv2prop", cvtext,
value = "0", width = "100%")),
bsTooltip("cv2prop", cvtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(
column(6, style='padding:0px;', actionButton("default2prop", defaulttext, width = "100%")),
column(6, style='padding:0px;', actionButton("clear2prop", clearalltext, width = "100%"))
),
fluidRow(
column(12, style='padding:0px;', actionButton("calc2prop", calctext, width = "100%",
style = umass)),
fluidRow(column(12, credittext))
)
), # end column(2, ..
column(10,
make_table_and_graph("2prop", names2prop)
) # end column(10,...
), # end tabPanel("Binary ...
#-----------------------------------------------------------------------------------------------------------
tabPanel("Binary DID",
column(2,
#----------------------------------------------------------
fluidRow(textInput("alpha2propD", alphatext,
value = "0.05", width = "100%")),
bsTooltip("alpha2propD", alphatooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("power2propD", powertext,
value = "", width = "100%")),
bsTooltip("power2propD", powertooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("p2propD", ptext,
value = "", width = "100%")),
bsTooltip("p2propD", ptooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("d2propD", dDtext,
value = "", width = "100%")),
bsTooltip("d2propD", dDtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("nclusters2propD", nclusterstext,
value = "", width = "100%")),
bsTooltip("nclusters2propD", nclusterstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("n2propD", nsubjectstext,
value = "", width = "100%")),
bsTooltip("n2propD", nsubjectstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("icc2propD", icctext,
value = "", width = "100%")),
bsTooltip("icc2propD", icctooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("rho_c2propD", rho_ctext,
value = "", width = "100%")),
bsTooltip("rho_c2propD", rho_ctooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("rho_s2propD", rho_stext,
value = "", width = "100%")),
bsTooltip("rho_s2propD", rho_stooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(
column(6, style='padding:0px;', actionButton("default2propD", defaulttext, width = "100%")),
column(6, style='padding:0px;', actionButton("clear2propD", clearalltext, width = "100%"))
),
fluidRow(
column(12, style='padding: 0px;', actionButton("calc2propD", calctext, width = "100%",
style = umass)),
fluidRow(column(12, credittext))
)
),
column(10,
make_table_and_graph("2propD", names2propD)
) # end column(10,...
), # end tabPanel("Binary DID ...
#-----------------------------------------------------------------------------------------------------------
tabPanel("Binary Matched",
column(2,
#----------------------------------------------------------
fluidRow(textInput("alpha2propM", alphatext,
value = "0.05", width = "100%")),
bsTooltip("alpha2propM", alphatooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("power2propM", powertext,
value = "0.80", width = "100%")),
bsTooltip("power2propM", powertooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("p12propM", p1text,
value = "", width = "100%")),
bsTooltip("p12propM", p1tooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("p22propM", p2text,
value = "", width = "100%")),
bsTooltip("p22propM", p2tooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(checkboxInput("p1inc2propM", p1inctext)),
bsTooltip("p1inc2propM", p1inctooltip,
'top', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("nclusters2propM", nclusterstext,
value = "", width = "100%")),
bsTooltip("nclusters2propM", nclusterstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("n2propM", nsubjectstext,
value = "", width = "100%")),
bsTooltip("n2propM", nsubjectstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("cvm2propM", cvmtext,
value = "", width = "100%")),
bsTooltip("cvm2propM", cvmtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(
column(6, style='padding:0px;', actionButton("default2propM", defaulttext, width = "100%")),
column(6, style='padding:0px;', actionButton("clear2propM", clearalltext, width = "100%"))
),
fluidRow(
column(12, style='padding:0px;', actionButton("calc2propM", calctext, width = "100%",
style = umass)),
fluidRow(column(12, credittext))
)
), # end column(2, ..
column(10,
make_table_and_graph("2propM", names2propM)
) # end column(10,...
), # end tabPanel("Binary Matched ...
#-----------------------------------------------------------------------------------------------------------
tabPanel("Count",
column(2,
#----------------------------------------------------------
fluidRow(textInput("alpha2rate", alphatext,
value = "0.05", width = "100%")),
bsTooltip("alpha2rate", alphatooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("power2rate", powertext,
value = "0.80", width = "100%")),
bsTooltip("power2rate", powertooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("r12rate", r1text,
value = "", width = "100%")),
bsTooltip("r12rate", r1tooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("r22rate", r2text,
value = "", width = "100%")),
bsTooltip("r22rate", r2tooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(checkboxInput("r1inc2rate", r1inctext)),
bsTooltip("r1inc2rate", r1inctooltip,
'top', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("nclusters2rate", nclusterstext,
value = "", width = "100%")),
bsTooltip("nclusters2rate", nclusterstooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("py2rate", pytext,
value = "", width = "100%")),
bsTooltip("py2rate", pytooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(textInput("cvb2rate", cvbtext,
value = "", width = "100%")),
bsTooltip("cvb2rate", cvbtooltip,
'right', options = list(container = "body")),
#----------------------------------------------------------
fluidRow(
column(6, style='padding:0px;', actionButton("default2rate", defaulttext, width = "100%")),
column(6, style='padding:0px;', actionButton("clear2rate", clearalltext, width = "100%"))),
fluidRow(
column(12, style='padding:0px;', actionButton("calc2rate", calctext, width = "100%",
style = umass)),
fluidRow(column(12,credittext))
)
),
column(10,
make_table_and_graph("2rate", names2rate)
) # end column(10,...
) # end tabPanel("Count ...
#-----------------------------------------------------------------------------------------------------------
) # end tabsetPanel
)} # end fluidPage
server <- function(input, output, session){
#----------------------------------------------------------------------------
# Two means
#----------------------------------------------------------------------------
# reset 2mean inputs to default values
observeEvent(
input$default2mean,
{
updateTextInput(session, inputId = "alpha2mean", value = "0.05")
updateTextInput(session, inputId = "power2mean", value = "")
updateTextInput(session, inputId = "cv2mean", value = "0")
updateCheckboxGroupInput(session, inputId = "method2mean", selected = "taylor")
updateTextInput(session, inputId = "nclusters2mean", value = "")
updateTextInput(session, inputId = "n2mean", value = "")
updateTextInput(session, inputId = "d2mean", value = "")
updateTextInput(session, inputId = "icc2mean", value = "")
updateTextInput(session, inputId = "vart2mean", value = "")
updateTextInput(session, inputId = "sigma_sq2mean", value = "")
updateTextInput(session, inputId = "sigma_b_sq2mean", value = "")
}
) # end observeEvent(input$default2mean ...
# clear 2mean inputs
observeEvent(
input$clear2mean,
{
updateTextInput(session, inputId = "alpha2mean", value = "")
updateTextInput(session, inputId = "power2mean", value = "")
updateTextInput(session, inputId = "cv2mean", value = "")
updateCheckboxGroupInput(session, inputId = "method2mean",
choices = c(Taylor = "taylor", Weighted = "weighted"))
updateTextInput(session, inputId = "nclusters2mean", value = "")
updateTextInput(session, inputId = "n2mean", value = "")
updateTextInput(session, inputId = "d2mean", value = "")
updateTextInput(session, inputId = "icc2mean", value = "")
updateTextInput(session, inputId = "vart2mean", value = "")
updateTextInput(session, inputId = "sigma_sq2mean", value = "")
updateTextInput(session, inputId = "sigma_b_sq2mean", value = "")
}
) # end observeEvent(input$clear2mean ...
# create 2mean data
res2mean <- eventReactive(
input$calc2mean,
{
# convert inputs to numeric vectors
alpha <- make_sequence(isolate(input$alpha2mean))
power <- make_sequence(isolate(input$power2mean))
nclusters <- make_sequence(isolate(input$nclusters2mean))
nsubjects <- make_sequence(isolate(input$n2mean))
sigma_sq <- make_sequence(isolate(input$sigma_sq2mean))
sigma_b_sq <- make_sequence(isolate(input$sigma_b_sq2mean))
CV <- make_sequence(isolate(input$cv2mean))
d <- make_sequence(isolate(input$d2mean))
ICC <- make_sequence(isolate(input$icc2mean))
vart <- make_sequence(isolate(input$vart2mean))
method <- na.omit(isolate(input$method2mean))
if(!is.na(power)){
validate(
need(power >= 0 & power <= 1,
powervalidmsg)
)
}
if(!is.na(alpha)){
validate(
need(alpha >= 0 & alpha <= 1,
alphavalidmsg)
)
}
# create a table of input values
tab <- expand.grid(alpha,
power,
nclusters,
nsubjects,
sigma_sq,
sigma_b_sq,
CV,
d,
ICC,
vart,
method,
stringsAsFactors = FALSE)
names(tab) <- names2mean
# check for sufficient variance parameters
varname <-
c(vart,
ICC,
sigma_sq,
sigma_b_sq
)
varind <- which(is.na(varname))
# validate that two of vart, ICC, sigma_sq, and sigma_b_sq are supplied
validate(
need(length(varind) == 2,
"Two (2) of ICC, vart, sigma_b,and sigma_b_sq must be supplied."
)
)
# needed inputs
neednames <-
c("alpha",
"power",
"nclusters",
"nsubjects",
"CV",
"d"
)
# record the column index of the target parameter
needind <- which(is.na(tab[1,neednames]))
# validate that only one input is blank
validate(
need(length(needind) == 1,
"Exactly one of 'alpha', 'power', 'nclusters', 'nsubjects', 'CV', and 'd' must be left blank."
)
)
target <- names2mean[needind]
# apply function over table of input values
temp <-pmap_df(tab, cpa.normal.safe)
tab[[target]] <- signif(temp$result, 4)
tab$error <- map_chr(temp$error, shorten_error, target = target)
# make a column to store target variable for use in graphing
tab$target <- target
# calculate missing values
if (!is.na(tab$sigma_b_sq[1]) && is.na(tab$vart[1])) {
tab$vart <- (tab$sigma_b_sq / tab$ICC)
}
if (!is.na(tab$sigma_sq[1]) && is.na(tab$vart[1])) {
tab$vart <- (tab$sigma_sq / (1 - tab$ICC))
}
if (!is.na(tab$sigma_b_sq[1]) && is.na(tab$ICC[1])) {
tab$ICC <- (tab$sigma_b_sq / tab$vart)
}
if (!is.na(tab$sigma_sq[1]) && is.na(tab$ICC[1])) {
tab$ICC <- (1 - (tab$sigma_sq / tab$vart))
}
if (is.na(tab$vart[1]) && is.na(tab$ICC[1])) {
tab$ICC <- ( (sigma_b_sq / (sigma_b_sq + sigma_sq) ) )
tab$vart <- (tab$sigma_b_sq + tab$sigma_sq)
}
# convert all input values to factors for ggplot
mutate_if(tab, !(names(tab) %in% c(target,"error","target")), factor)
})
# create 2mean output table
output$table2mean <- DT::renderDataTable(
res2mean()[,1:12],
server = FALSE,
extensions = 'Buttons',
filter = 'top',
options = list(
# create the button
dom = 'fBrtlip',
buttons = list(list(extend = 'csv', filename = paste('data-2mean-', Sys.time(), sep=''), text = 'Download')),
#autoWidth = TRUE,
columnDefs = list(list(className = 'dt-center', targets = '_all'),
list(width = '700px', targets = 10)),
lengthMenu = list(c(10, 25, 100, -1), list('10','25','100','All')),
pageLength = 10
)
)
# update graph UI
observeEvent(res2mean(),
{
update_graph_ui(session, res2mean(), "2mean", names2mean)
})
# create 2mean graph
output$graph2mean <- renderPlot({
create_graph(res2mean(), input$x2mean, input$y2mean, input$group2mean,
input$lsize2mean, input$psize2mean, input$row2mean, input$col2mean)
},
width = reactive({input$width2mean}),
height = reactive({input$height2mean})
)
#----------------------------------------------------------------------------
# Two means: Difference in difference
#----------------------------------------------------------------------------
# reset 2meanD inputs to default values
observeEvent(
input$default2meanD,
{
updateTextInput(session, inputId = "alpha2meanD", value = "0.05")
updateTextInput(session, inputId = "power2meanD", value = "")
updateTextInput(session, inputId = "rho_c2meanD", value = "")
updateTextInput(session, inputId = "rho_s2meanD", value = "")
updateTextInput(session, inputId = "nclusters2meanD", value = "")
updateTextInput(session, inputId = "n2meanD", value = "")
updateTextInput(session, inputId = "d2meanD", value = "")
updateTextInput(session, inputId = "icc2meanD", value = "")
updateTextInput(session, inputId = "vart2meanD", value = "")
}
) # end observeEvent(input$default2meanD ...
# clear 2meanD inputs
observeEvent(
input$clear2meanD,
{
updateTextInput(session, inputId = "alpha2meanD", value = "")
updateTextInput(session, inputId = "power2meanD", value = "")
updateTextInput(session, inputId = "rho_c2meanD", value = "")
updateTextInput(session, inputId = "rho_s2meanD", value = "")
updateTextInput(session, inputId = "nclusters2meanD", value = "")
updateTextInput(session, inputId = "n2meanD", value = "")
updateTextInput(session, inputId = "d2meanD", value = "")
updateTextInput(session, inputId = "icc2meanD", value = "")
updateTextInput(session, inputId = "vart2meanD", value = "")
}
) # end observeEvent(input$clear2meanD ...
# create 2meanD data
res2meanD <- eventReactive(
input$calc2meanD,
{
# convert inputs to numeric vectors
alpha <- make_sequence(isolate(input$alpha2meanD))
power <- make_sequence(isolate(input$power2meanD))
nclusters <- make_sequence(isolate(input$nclusters2meanD))
nsubjects <- make_sequence(isolate(input$n2meanD))
rho_c <- make_sequence(isolate(input$rho_c2meanD))
rho_s <- make_sequence(isolate(input$rho_s2meanD))
d <- make_sequence(isolate(input$d2meanD))
ICC <- make_sequence(isolate(input$icc2meanD))
vart <- make_sequence(isolate(input$vart2meanD))
if(!is.na(power)){
validate(
need(power >= 0 & power <= 1,
powervalidmsg)
)
}
if(!is.na(alpha)){
validate(
need(alpha >= 0 & alpha <= 1,
alphavalidmsg)
)
}
# create a table of input values
tab <- expand.grid(alpha,
power,
nclusters,
nsubjects,
d,
ICC,
rho_c,
rho_s,
vart,
stringsAsFactors = FALSE)
# record the column index of the target parameter
needind <- which(is.na(tab[1,]))
# validate that only one input is blank
validate(
need(length(needind) == 1,
"Exactly one of 'alpha', 'power', 'd', 'nclusters', 'nsubjects', 'icc', 'rho_c', 'rho_s', and 'vart' must be left blank."
)
)
names(tab) <- names2meanD
target <- names2meanD[needind]
# apply function over table of input values
temp <-pmap_df(tab, cpa.did.normal.safe)
tab[[target]] <- signif(temp$result, 4)
tab$error <- map_chr(temp$error, shorten_error, target = target)
# make a column to store target variable for use in graphing
tab$target <- target
# check to see if there are errors, if so, set maxcol to 10 to show error in datatable
# if not, set colmax to 9 so that error column not displayed
#tab$colmax <- ifelse(sum(!is.na(res2meanD()$error) != 0, 10, 9))
# convert all input values to factors for ggplot
mutate_if(tab, !(names(tab) %in% c(target,"error","target")), factor)
})
# create 2meanD output table
output$table2meanD <- DT::renderDataTable(
res2meanD()[, 1:10],
server = FALSE,
extensions = 'Buttons',
filter = 'top',
options = list(
# create the button
dom = 'fBrtlip',
buttons = list(list(extend = 'csv', filename = paste('data-2meanD-', Sys.time(), sep=''), text = 'Download')),
#autoWidth = TRUE,
columnDefs = list(list(className = 'dt-center', targets = '_all'),
list(width = '500px', targets = 10)),
pageLength = 10,
lengthMenu = list(c(10, 25, 100, -1), list('10', '25', '100', 'All'))
)
)
# update graph UI
observeEvent(res2meanD(),
{
update_graph_ui(session, res2meanD(), "2meanD", names2meanD)
})
# create 2meanD graph
output$graph2meanD <- renderPlot({
create_graph(res2meanD(), input$x2meanD, input$y2meanD, input$group2meanD,
input$lsize2meanD, input$psize2meanD, input$row2meanD, input$col2meanD)
},
width = reactive({input$width2meanD}),
height = reactive({input$height2meanD})
)
#----------------------------------------------------------------------------
# Stepped Wedge
#----------------------------------------------------------------------------
# reset SW inputs to default values
observeEvent(
input$defaultSW,
{
updateTextInput(session, inputId = "alphaSW", value = "0.05")
updateTextInput(session, inputId = "powerSW", value = "")
updateTextInput(session, inputId = "dSW", value = "")
updateTextInput(session, inputId = "nclustersSW", value = "")
updateTextInput(session, inputId = "nsubjectsSW", value = "")
updateTextInput(session, inputId = "ntimesSW", value = "")
updateTextInput(session, inputId = "iccSW", value = "")
updateTextInput(session, inputId = "rho_cSW", value = "")
updateTextInput(session, inputId = "rho_sSW", value = "")
updateTextInput(session, inputId = "vartSW", value = "")
}
) # end observeEvent(input$defaultSW ...
# clear SW inputs
observeEvent(
input$clearSW,
{
updateTextInput(session, inputId = "alphaSW", value = "")
updateTextInput(session, inputId = "powerSW", value = "")
updateTextInput(session, inputId = "rho_cSW", value = "")
updateTextInput(session, inputId = "rho_sSW", value = "")
updateTextInput(session, inputId = "nclustersSW", value = "")
updateTextInput(session, inputId = "nsubjectsSW", value = "")
updateTextInput(session, inputId = "ntimesSW", value = "")
updateTextInput(session, inputId = "dSW", value = "")
updateTextInput(session, inputId = "iccSW", value = "")
updateTextInput(session, inputId = "vartSW", value = "")
}
) # end observeEvent(input$clearSW ...
# create SW data
resSW <- eventReactive(
input$calcSW,
{
# convert inputs to numeric vectors
alpha <- make_sequence(isolate(input$alphaSW))
power <- make_sequence(isolate(input$powerSW))
nclusters <- make_sequence(isolate(input$nclustersSW))
nsubjects <- make_sequence(isolate(input$nsubjectsSW))
ntimes <- make_sequence(isolate(input$ntimesSW))
d <- make_sequence(isolate(input$dSW))
icc <- make_sequence(isolate(input$iccSW))
rho_c <- make_sequence(isolate(input$rho_cSW))
rho_s <- make_sequence(isolate(input$rho_sSW))
vart <- make_sequence(isolate(input$vartSW))
if(!is.na(power)){
validate(
need(power >= 0 & power <= 1,
powervalidmsg)
)
}
if(!is.na(alpha)){
validate(
need(alpha >= 0 & alpha <= 1,
alphavalidmsg)
)
}
# create a table of input values
tab <- expand.grid(alpha,
power,
nclusters,
nsubjects,
ntimes,
d,
icc,
rho_c,
rho_s,
vart,
stringsAsFactors = FALSE)
# record the column index of the target parameter
needind <- which(is.na(tab[1,]))
# validate that only one input is blank
validate(
need(length(needind) == 1,
"Exactly one of 'alpha', 'power', 'd', 'ntimes', 'nclusters', 'nsubjects', 'icc', 'rho_c', 'rho_s', and 'vart' must be left blank."
)
)
names(tab) <- namesSW
target <- namesSW[needind]
# apply function over table of input values
temp <-pmap_df(tab, cpa.sw.normal.safe)
tab[[target]] <- signif(temp$result, 4)
tab$error <- map_chr(temp$error, shorten_error, target = target)
# make a column to store target variable for use in graphing
tab$target <- target
# check to see if there are errors, if so, set maxcol to 10 to show error in datatable
# if not, set colmax to 9 so that error column not displayed
#tab$colmax <- ifelse(sum(!is.na(resSW()$error) != 0, 10, 9))
# convert all input values to factors for ggplot
mutate_if(tab, !(names(tab) %in% c(target,"error","target")), factor)
})
# create SW output table
output$tableSW <- DT::renderDataTable(
resSW()[, 1:11],
server = FALSE,
extensions = 'Buttons',
filter = 'top',
options = list(
# create the button
dom = 'fBrtlip',
buttons = list(list(extend = 'csv', filename = paste('data-SW-', Sys.time(), sep=''), text = 'Download')),
#autoWidth = TRUE,
columnDefs = list(list(className = 'dt-center', targets = '_all'),
list(width = '500px', targets = 11)),
pageLength = 10,
lengthMenu = list(c(10, 25, 100, -1), list('10', '25', '100', 'All'))
)
)
# update graph UI
observeEvent(resSW(),
{
update_graph_ui(session, resSW(), "SW", namesSW)
})
# create SW graph
output$graphSW <- renderPlot({
create_graph(resSW(), input$xSW, input$ySW, input$groupSW,
input$lsizeSW, input$psizeSW, input$rowSW, input$colSW)
},
width = reactive({input$widthSW}),
height = reactive({input$heightSW})
)
#----------------------------------------------------------------------------
# Two means: Matching
#----------------------------------------------------------------------------
# reset 2meanM inputs to default values
observeEvent(
input$default2meanM,
{
updateTextInput(session, inputId = "alpha2meanM", value = "0.05")
updateTextInput(session, inputId = "power2meanM", value = "")
updateTextInput(session, inputId = "rho_m2meanM", value = "")
updateTextInput(session, inputId = "nclusters2meanM", value = "")
updateTextInput(session, inputId = "n2meanM", value = "")
updateTextInput(session, inputId = "d2meanM", value = "")
updateTextInput(session, inputId = "icc2meanM", value = "")
updateTextInput(session, inputId = "vart2meanM", value = "")
}
) # end observeEvent(input$default2meanM ...
# clear 2meanM inputs
observeEvent(
input$clear2meanM,
{
updateTextInput(session, inputId = "alpha2meanM", value = "")
updateTextInput(session, inputId = "power2meanM", value = "")
updateTextInput(session, inputId = "rho_m2meanM", value = "")
updateTextInput(session, inputId = "nclusters2meanM", value = "")
updateTextInput(session, inputId = "n2meanM", value = "")
updateTextInput(session, inputId = "d2meanM", value = "")
updateTextInput(session, inputId = "icc2meanM", value = "")
updateTextInput(session, inputId = "vart2meanM", value = "")
}
) # end observeEvent(input$clear2meanM ...
# create 2meanM data
res2meanM <- eventReactive(
input$calc2meanM,
{
# convert inputs to numeric vectors
alpha <- make_sequence(isolate(input$alpha2meanM))
power <- make_sequence(isolate(input$power2meanM))
nclusters <- make_sequence(isolate(input$nclusters2meanM))
nsubjects <- make_sequence(isolate(input$n2meanM))
rho_m <- make_sequence(isolate(input$rho_m2meanM))
d <- make_sequence(isolate(input$d2meanM))
icc <- make_sequence(isolate(input$icc2meanM))
vart <- make_sequence(isolate(input$vart2meanM))
if(!is.na(power)){
validate(
need(power >= 0 & power <= 1,
powervalidmsg)
)
}
if(!is.na(alpha)){
validate(
need(alpha >= 0 & alpha <= 1,
alphavalidmsg)
)
}
# create a table of input values
tab <- expand.grid(alpha,
power,
nclusters,
nsubjects,
d,
icc,
vart,
rho_m,
stringsAsFactors = FALSE)
# record the column index of the target parameter
needind <- which(is.na(tab[1,]))
# validate that only one input is blank
validate(
need(length(needind) == 1,
"Exactly one of 'alpha', 'power', 'd', 'nclusters', 'nsubjects', 'icc', 'rho_m', and 'vart' must be left blank."
)
)
names(tab) <- names2meanM
target <- names2meanM[needind]
# apply function over table of input values
temp <-pmap_df(tab, crtpwr.2meanM.safe)
tab[[target]] <- signif(temp$result, 4)
tab$error <- map_chr(temp$error, shorten_error, target = target)
# make a column to store target variable for use in graphing
tab$target <- target
# check to see if there are errors, if so, set maxcol to 10 to show error in datatable
# if not, set colmax to 9 so that error column not displayed
#tab$colmax <- ifelse(sum(!is.na(res2meanM()$error) != 0, 10, 9))
# convert all input values to factors for ggplot
mutate_if(tab, !(names(tab) %in% c(target,"error","target")), factor)
})
# create 2meanM output table
output$table2meanM <- DT::renderDataTable(
res2meanM()[, 1:10],
server = FALSE,
extensions = 'Buttons',
filter = 'top',
options = list(
# create the button
dom = 'fBrtlip',
buttons = list(list(extend = 'csv', filename = paste('data-2meanM-', Sys.time(), sep=''), text = 'Download')),
#autoWidth = TRUE,
columnDefs = list(list(className = 'dt-center', targets = '_all'),
list(width = '500px', targets = 10)),
pageLength = 10,
lengthMenu = list(c(10, 25, 100, -1), list('10', '25', '100', 'All'))
)
)
# update graph UI
observeEvent(res2meanM(),
{
update_graph_ui(session, res2meanM(), "2meanM", names2meanM)
})
# create 2meanM graph
output$graph2meanM <- renderPlot({
create_graph(res2meanM(), input$x2meanM, input$y2meanM, input$group2meanM,
input$lsize2meanM, input$psize2meanM, input$row2meanM, input$col2meanM)
},
width = reactive({input$width2meanM}),
height = reactive({input$height2meanM})
)
#----------------------------------------------------------------------------
# Multi-Arm (nmean)
#----------------------------------------------------------------------------
# reset nmean inputs to default values
observeEvent(
input$defaultnmean,
{
updateTextInput(session, inputId = "alphanmean", value = "0.05")
updateTextInput(session, inputId = "powernmean", value = "")
updateTextInput(session, inputId = "narmnmean", value = "")
updateTextInput(session, inputId = "nclustersnmean", value = "")
updateTextInput(session, inputId = "nnmean", value = "")
updateTextInput(session, inputId = "varanmean", value = "")
updateTextInput(session, inputId = "varcnmean", value = "")
updateTextInput(session, inputId = "varenmean", value = "")
}
) # end observeEvent(input$defaultnmean ...
# clear nmean inputs
observeEvent(
input$clearnmean,
{
updateTextInput(session, inputId = "alphanmean", value = "")
updateTextInput(session, inputId = "powernmean", value = "")
updateTextInput(session, inputId = "narmnmean", value = "")
updateTextInput(session, inputId = "nclustersnmean", value = "")
updateTextInput(session, inputId = "nnmean", value = "")
updateTextInput(session, inputId = "varanmean", value = "")
updateTextInput(session, inputId = "varcnmean", value = "")
updateTextInput(session, inputId = "varenmean", value = "")
}
) # end observeEvent(input$clearnmean ...
# create nmean data
resnmean <- eventReactive(
input$calcnmean,
{
# convert inputs to numeric vectors
alpha <- make_sequence(isolate(input$alphanmean))
power <- make_sequence(isolate(input$powernmean))
narms <- make_sequence(isolate(input$narmsnmean))
nclusters <- make_sequence(isolate(input$nclustersnmean))
nsubjects <- make_sequence(isolate(input$nnmean))
vara <- make_sequence(isolate(input$varanmean))
varc <- make_sequence(isolate(input$varcnmean))
vare <- make_sequence(isolate(input$varenmean))
if(!is.na(power)){
validate(
need(power >= 0 & power <= 1,
powervalidmsg)
)
}
if(!is.na(alpha)){
validate(
need(alpha >= 0 & alpha <= 1,
alphavalidmsg)
)
}
# create a table of input values
tab <- expand.grid(alpha,
power,
narms,
nclusters,
nsubjects,
vara,
varc,
vare,
stringsAsFactors = FALSE)
# record the column index of the target parameter
needind <- which(is.na(tab[1,]))
# validate that only one input is blank
validate(
need(length(needind) == 1,
"Exactly one of 'alpha', 'power', 'narms', 'nclusters', 'nsubjects', 'vara', 'varc', and 'vare' must be left blank."
)
)
names(tab) <- namesnmean
target <- namesnmean[needind]
# apply function over table of input values
temp <-pmap_df(tab, cpa.ma.normal.safe)
tab[[target]] <- signif(temp$result, 4)
tab$error <- map_chr(temp$error, shorten_error, target = target)
# make a column to store target variable for use in graphing
tab$target <- target
# convert all input values to factors for ggplot
mutate_if(tab, !(names(tab) %in% c(target,"error","target")), factor)
})
# create nmean output table
output$tablenmean <- DT::renderDataTable(
resnmean()[,1:10],
server = FALSE,
extensions = 'Buttons',
filter = 'top',
options = list(
# create the button
dom = 'fBrtlip',
buttons = list(list(extend = 'csv', filename = paste('data-nmean-', Sys.time(), sep=''), text = 'Download')),
#autoWidth = TRUE,
columnDefs = list(list(className = 'dt-center', targets = '_all'),
list(width = '700px', targets = 10)),
lengthMenu = list(c(10, 25, 100, -1), list('10','25','100','All')),
pageLength = 10
)
)
# update graph UI
observeEvent(resnmean(),
{
update_graph_ui(session, resnmean(), "nmean", namesnmean)
})
# create nmean graph
output$graphnmean <- renderPlot({
create_graph(resnmean(), input$xnmean, input$ynmean, input$groupnmean,
input$lsizenmean, input$psizenmean, input$rownmean, input$colnmean)
},
width = reactive({input$widthnmean}),
height = reactive({input$heightnmean})
)
#----------------------------------------------------------------------------
# Two proportions
#----------------------------------------------------------------------------
# reset 2prop inputs to default values
observeEvent(
input$default2prop,
{
updateTextInput(session, inputId = "alpha2prop", value = "0.05")
updateTextInput(session, inputId = "power2prop", value = "")
updateTextInput(session, inputId = "cv2prop", value = "")
updateTextInput(session, inputId = "nclusters2prop", value = "")
updateTextInput(session, inputId = "n2prop", value = "")
updateTextInput(session, inputId = "icc2prop", value = "")
updateTextInput(session, inputId = "p12prop", value = "")
updateTextInput(session, inputId = "p22prop", value = "")
updateTextInput(session, inputId = "pooled2prop", value = FALSE)
updateTextInput(session, inputId = "p1inc2prop", value = FALSE)
updateTextInput(session, inputId = "ttest2prop", value = FALSE)
} # end observeEvent(input$default2prop ...
)
# clear 2prop inputs
observeEvent(
input$clear2prop,
{
updateTextInput(session, inputId = "alpha2prop", value = "")
updateTextInput(session, inputId = "power2prop", value = "")
updateTextInput(session, inputId = "cv2prop", value = "")
updateTextInput(session, inputId = "nclusters2prop", value = "")
updateTextInput(session, inputId = "n2prop", value = "")
updateTextInput(session, inputId = "icc2prop", value = "")
updateTextInput(session, inputId = "p12prop", value = "")
updateTextInput(session, inputId = "p22prop", value = "")
updateTextInput(session, inputId = "pooled2prop", value = FALSE)
updateTextInput(session, inputId = "p1inc2prop", value = FALSE)
updateTextInput(session, inputId = "ttest2prop", value = FALSE)
}
) # end observeEvent(input$clear2prop ...
# create 2prop data
res2prop <- eventReactive(
input$calc2prop,
{
alpha <- make_sequence(isolate(input$alpha2prop))
power <- make_sequence(isolate(input$power2prop))
nclusters <- make_sequence(isolate(input$nclusters2prop))
nsubjects <- make_sequence(isolate(input$n2prop))
cv <- make_sequence(isolate(input$cv2prop))
p1 <- make_sequence(isolate(input$p12prop))
p2 <- make_sequence(isolate(input$p22prop))
ICC <- make_sequence(isolate(input$icc2prop))
pooled <- isolate(input$pooled2prop)
p1inc <- isolate(input$p1inc2prop)
ttest <- isolate(input$ttest2prop)
tab <- expand.grid(alpha,
power,
nclusters,
nsubjects,
cv,
p1,
p2,
ICC,
pooled,
p1inc,
ttest,
stringsAsFactors = FALSE)
if(!is.na(power)){
validate(
need(power >= 0 & power <= 1,
powervalidmsg)
)
}
if(!is.na(alpha)){
validate(
need(alpha >= 0 & alpha <= 1,
alphavalidmsg)
)
}
# record the column index of the target parameter
needind <- which(is.na(tab[1,]))
# validate that only one input is blank
validate(
need(length(needind) == 1,
"Exactly one of 'alpha', 'power', 'p1', 'p2', 'nclusters', 'nsubjects', 'ICC' or 'cv' must be left blank."
)
)
names(tab) <- names2prop
target <- names2prop[needind]
# apply function over table of input values
temp <-pmap_df(tab, cpa.binary.safe)
tab[[target]] <- signif(temp$result, 4)
tab$error <- map_chr(temp$error, shorten_error, target = target)
# make a column to store target variable for use in graphing
tab$target <- target
# convert all input values to factors for ggplot
mutate_if(tab, !(names(tab) %in% c(target,"error","target")), factor)
})
# create 2prop output table
output$table2prop <- DT::renderDataTable(
res2prop()[,c(1:8,12)],
server = FALSE,
extensions = 'Buttons',
filter = 'top',
options = list(
# create the button
dom = 'fBrtlip',
buttons = list(list(extend = 'csv', filename = paste('data-2prop-', Sys.time(), sep=''), text = 'Download')),
#autoWidth = TRUE,
columnDefs = list(list(className = 'dt-center', targets = '_all'),
list(width = '500px', targets = 9)),
pageLength = 10,
lengthMenu = list(c(10, 25, 100, -1), list('10', '25', '100', 'All'))
)
)
# update graph UI
observeEvent(res2prop(),
{
update_graph_ui(session, res2prop(), "2prop", names2prop)
})
# create 2prop graph
output$graph2prop <- renderPlot({
create_graph(res2prop(), input$x2prop, input$y2prop, input$group2prop,
input$lsize2prop, input$psize2prop, input$row2prop, input$col2prop)
},
width = reactive({input$width2prop}),
height = reactive({input$height2prop})
)
#----------------------------------------------------------------------------
# Two proportions, difference in difference
#----------------------------------------------------------------------------
# reset 2propD inputs to default values
observeEvent(
input$default2propD,
{
updateTextInput(session, inputId = "alpha2propD", value = "0.05")
updateTextInput(session, inputId = "power2propD", value = "")
updateTextInput(session, inputId = "rho_c2propD", value = "")
updateTextInput(session, inputId = "rho_s2propD", value = "")
updateTextInput(session, inputId = "nclusters2propD", value = "")
updateTextInput(session, inputId = "nubjects2propD", value = "")
updateTextInput(session, inputId = "n2propD", value = "")
updateTextInput(session, inputId = "p2propD", value = "")
updateTextInput(session, inputId = "d2propD", value = "")
updateTextInput(session, inputId = "icc2propD", value = "")
}
) # end observeEvent(input$default2propD ...
# clear 2propD inputs
observeEvent(
input$clear2propD,
{
updateTextInput(session, inputId = "alpha2propD", value = "")
updateTextInput(session, inputId = "power2propD", value = "")
updateTextInput(session, inputId = "rho_c2propD", value = "")
updateTextInput(session, inputId = "rho_s2propD", value = "")
updateTextInput(session, inputId = "nclusters2propD", value = "")
updateTextInput(session, inputId = "nubjects2propD", value = "")
updateTextInput(session, inputId = "n2propD", value = "")
updateTextInput(session, inputId = "p2propD", value = "")
updateTextInput(session, inputId = "d2propD", value = "")
updateTextInput(session, inputId = "icc2propD", value = "")
}
) # end observeEvent(input$clear2propD ...
# create 2propD data
res2propD <- eventReactive(
input$calc2propD,
{
# convert inputs to numeric vectors
alpha <- make_sequence(isolate(input$alpha2propD))
power <- make_sequence(isolate(input$power2propD))
nclusters <- make_sequence(isolate(input$nclusters2propD))
nsubjects <- make_sequence(isolate(input$n2propD))
rho_c <- make_sequence(isolate(input$rho_c2propD))
rho_s <- make_sequence(isolate(input$rho_s2propD))
p <- make_sequence(isolate(input$p2propD))
d <- make_sequence(isolate(input$d2propD))
ICC <- make_sequence(isolate(input$icc2propD))
if(!is.na(power)){
validate(
need(power >= 0 & power <= 1,
powervalidmsg)
)
}
if(!is.na(alpha)){
validate(
need(alpha >= 0 & alpha <= 1,
alphavalidmsg)
)
}
# create a table of input values
tab <- expand.grid(alpha,
power,
nclusters,
nsubjects,
p,
d,
ICC,
rho_c,
rho_s,
stringsAsFactors = FALSE)
# record the column index of the target parameter
needind <- which(is.na(tab[1,]))
# validate that only one input is blank
validate(
need(length(needind) == 1,
"Exactly one of 'alpha', 'power', 'p', 'd', 'nclusters', 'nsubjects', 'icc', 'rho_c', and 'rho_s' must be left blank."
)
)
names(tab) <- names2propD
target <- names2propD[needind]
# apply function over table of input values
temp <-pmap_df(tab, cpa.did.binary.safe)
tab[[target]] <- signif(temp$result, 4)
tab$error <- map_chr(temp$error, shorten_error, target = target)
# make a column to store target variable for use in graphing
tab$target <- target
# check to see if there are errors, if so, set maxcol to 10 to show error in datatable
# if not, set colmax to 9 so that error column not displayed
#tab$colmax <- ifelse(sum(!is.na(res2propD()$error) != 0, 10, 9))
# convert all input values to factors for ggplot
mutate_if(tab, !(names(tab) %in% c(target,"error","target")), factor)
})
# create 2propD output table
output$table2propD <- DT::renderDataTable(
res2propD()[, c(1:10)],
server = FALSE,
extensions = 'Buttons',
filter = 'top',
options = list(
# create the button
dom = 'fBrtlip',
buttons = list(list(extend = 'csv', filename = paste('data-2propD-', Sys.time(), sep=''), text = 'Download')),
#autoWidth = TRUE,
columnDefs = list(list(className = 'dt-center', targets = '_all'),
list(width = '500px', targets = 10)),
pageLength = 10,
lengthMenu = list(c(10, 25, 100, -1), list('10', '25', '100', 'All'))
)
)
# update graph UI
observeEvent(res2propD(),
{
update_graph_ui(session, res2propD(), "2propD", names2propD)
})
# create 2propD graph
output$graph2propD <- renderPlot({
create_graph(res2propD(), input$x2propD, input$y2propD, input$group2propD,
input$lsize2propD, input$psize2propD, input$row2propD, input$col2propD)
},
width = reactive({input$width2propD}),
height = reactive({input$height2propD})
)
#----------------------------------------------------------------------------
# Two proportions, matched
#----------------------------------------------------------------------------
# reset 2propM inputs to default values
observeEvent(
input$default2propM,
{
updateTextInput(session, inputId = "alpha2propM", value = "0.05")
updateTextInput(session, inputId = "power2propM", value = "0.80")
updateTextInput(session, inputId = "cvm2propM", value = "")
updateTextInput(session, inputId = "nclusters2propM", value = "")
updateTextInput(session, inputId = "n2propM", value = "")
updateTextInput(session, inputId = "p12propM", value = "")
updateTextInput(session, inputId = "p22propM", value = "")
updateTextInput(session, inputId = "p1inc2propM", value = FALSE)
} # end observeEvent(input$default2propM ...
)
# clear 2propM inputs
observeEvent(
input$clear2propM,
{
updateTextInput(session, inputId = "alpha2propM", value = "")
updateTextInput(session, inputId = "power2propM", value = "")
updateTextInput(session, inputId = "cvm2propM", value = "")
updateTextInput(session, inputId = "nclusters2propM", value = "")
updateTextInput(session, inputId = "n2propM", value = "")
updateTextInput(session, inputId = "p12propM", value = "")
updateTextInput(session, inputId = "p22propM", value = "")
updateTextInput(session, inputId = "p1inc2propM", value = FALSE)
}
) # end observeEvent(input$clear2propM ...
# create 2propM data
res2propM <- eventReactive(
input$calc2propM,
{
alpha <- make_sequence(isolate(input$alpha2propM))
power <- make_sequence(isolate(input$power2propM))
nclusters <- make_sequence(isolate(input$nclusters2propM))
nsubjects <- make_sequence(isolate(input$n2propM))
p1 <- make_sequence(isolate(input$p12propM))
p2 <- make_sequence(isolate(input$p22propM))
cvm <- make_sequence(isolate(input$cvm2propM))
p1inc <- isolate(input$p1inc2propM)
tab <- expand.grid(alpha,
power,
nclusters,
nsubjects,
p1,
p2,
cvm,
p1inc,
stringsAsFactors = FALSE)
if(!is.na(power)){
validate(
need(power >= 0 & power <= 1,
powervalidmsg)
)
}
if(!is.na(alpha)){
validate(
need(alpha >= 0 & alpha <= 1,
alphavalidmsg)
)
}
# record the column index of the target parameter
needind <- which(is.na(tab[1,]))
# validate that only one input is blank
validate(
need(length(needind) == 1,
"Exactly one of 'alpha', 'power', 'p1', 'p2', 'nclusters', 'nsubjects', or 'cvm' must be left blank."
)
)
names(tab) <- names2propM
target <- names2propM[needind]
# apply function over table of input values
temp <-pmap_df(tab, crtpwr.2propM.safe)
tab[[target]] <- signif(temp$result, 4)
tab$error <- map_chr(temp$error, shorten_error, target = target)
# make a column to store target variable for use in graphing
tab$target <- target
# convert all input values to factors for ggplot
mutate_if(tab, !(names(tab) %in% c(target,"error","target")), factor)
})
# create 2propM output table
output$table2propM <- DT::renderDataTable(
res2propM()[,c(1:7,9)],
server = FALSE,
extensions = 'Buttons',
filter = 'top',
options = list(
# create the button
dom = 'fBrtlip',
buttons = list(list(extend = 'csv', filename = paste('data-2propM-', Sys.time(), sep=''), text = 'Download')),
#autoWidth = TRUE,
columnDefs = list(list(className = 'dt-center', targets = '_all'),
list(width = '500px', targets = 8)),
pageLength = 10,
lengthMenu = list(c(10, 25, 100, -1), list('10', '25', '100', 'All'))
)
)
# update graph UI
observeEvent(res2propM(),
{
update_graph_ui(session, res2propM(), "2propM", names2propM)
})
# create 2propM graph
output$graph2propM <- renderPlot({
create_graph(res2propM(), input$x2propM, input$y2propM, input$group2propM,
input$lsize2propM, input$psize2propM, input$row2propM, input$col2propM)
},
width = reactive({input$width2propM}),
height = reactive({input$height2propM})
)
#----------------------------------------------------------------------------
# Two rates
#----------------------------------------------------------------------------
# reset 2rate inputs to default values
observeEvent(
input$default2rate,
{
updateTextInput(session, inputId = "alpha2rate", value = "0.05")
updateTextInput(session, inputId = "power2rate", value = "0.80")
updateTextInput(session, inputId = "nclusters2rate", value = "")
updateTextInput(session, inputId = "py2rate", value = "")
updateTextInput(session, inputId = "r12rate", value = "")
updateTextInput(session, inputId = "r22rate", value = "")
updateTextInput(session, inputId = "cvb2rate", value = "")
updateTextInput(session, inputId = "r1inc2rate", value = FALSE)
} # end observeEvent(input$default2rate ...
)
# clear 2rate inputs
observeEvent(
input$clear2rate,
{
updateTextInput(session, inputId = "alpha2rate", value = "")
updateTextInput(session, inputId = "power2rate", value = "")
updateTextInput(session, inputId = "nclusters2rate", value = "")
updateTextInput(session, inputId = "py2rate", value = "")
updateTextInput(session, inputId = "r12rate", value = "")
updateTextInput(session, inputId = "r22rate", value = "")
updateTextInput(session, inputId = "cvb2rate", value = "")
updateTextInput(session, inputId = "r1inc2rate", value = FALSE)
} # end observeEvent(input$clear2rate ...
)
# create 2rate data
res2rate <- eventReactive(
input$calc2rate,
{
alpha <- make_sequence(isolate(input$alpha2rate))
power <- make_sequence(isolate(input$power2rate))
nclusters <- make_sequence(isolate(input$nclusters2rate))
py <- make_sequence(isolate(input$py2rate))
r1 <- make_sequence(isolate(input$r12rate))
r2 <- make_sequence(isolate(input$r22rate))
CVB <- make_sequence(isolate(input$cvb2rate))
r1inc <- isolate(input$r1inc2rate)
tab <- expand.grid(alpha,
power,
nclusters,
py,
r1,
r2,
CVB,
r1inc,
stringsAsFactors = FALSE)
if(!is.na(power)){
validate(
need(power >= 0 & power <= 1,
powervalidmsg)
)
}
if(!is.na(alpha)){
validate(
need(alpha >= 0 & alpha <= 1,
alphavalidmsg)
)
}
# record column index of target parameter
needind <- which(is.na(tab[1,]))
# validate that only one input is blank
validate(
need(length(needind) == 1,
"Exactly one of 'alpha', 'power', 'r1', 'r2', 'nclusters', 'py', or 'cvb' must be left blank."
)
)
names(tab) <- names2rate
target <- names2rate[needind]
# apply function over table of input values
temp <-pmap_df(tab, cpa.count.safe)
tab[[target]] <- signif(temp$result, 4)
tab$error <- map_chr(temp$error, shorten_error, target = target)
# make a column to store target variable for use in graphing
tab$target <- target
# convert all input values to factors for ggplot
mutate_if(tab, !(names(tab) %in% c(target,"error","target")), factor)
})
# create 2rate output table
output$table2rate <- DT::renderDataTable(
res2rate()[,c(1:7,9)],
server = FALSE,
extensions = 'Buttons',
filter = 'top',
options = list(
# create the button
dom = 'fBrtlip',
buttons = list(list(extend = 'csv', filename = paste('data-2rate-', Sys.time(), sep=''), text = 'Download')),
#autoWidth = TRUE,
columnDefs = list(list(className = 'dt-center', targets = '_all'),
list(width = '500px', targets = 8)),
pageLength = 10,
lengthMenu = list(c(10, 25, 100, -1), list('10', '25', '100', 'All'))
)
)
# update graph UI
observeEvent(res2rate(),
{
update_graph_ui(session, res2rate(), "2rate", names2rate)
})
# create 2rate graph
output$graph2rate <- renderPlot({
create_graph(res2rate(), input$x2rate, input$y2rate, input$group2rate,
input$lsize2rate, input$psize2rate, input$row2rate, input$col2rate)
},
width = reactive({input$width2rate}),
height = reactive({input$height2rate})
)
}
shinyApp(ui = ui, server = server, enableBookmarking = "server")
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.