Skip to content
Permalink
f64ed56444
Switch branches/tags

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
Go to file
 
 
Cannot retrieve contributors at this time
308 lines (199 sloc) 11.9 KB
# --------------------------------------------------------
# -----------------Server---------------------------------
# --------------------------------------------------------
## Load Packages
library("shiny")
library("semantic.dashboard")
library("pwr")
server <- function(input, output) {
# ---------------General npRCT functions-------------
## T-test
npRCT.t <- reactive({
# Run power calculation for first t-test (traditional part of RCST)
t1 <- pwr.t.test(d = input$t.d1,
sig.level = input$t.sig.level1,
power = input$t.power1,
alternative = input$t.alternative1,
type = "two.sample")
# Run power calculation for second t-test (stratified part of RCST)
t2 <- pwr.t.test(d = input$t.d2, sig.level = input$t.sig.level2,
power = input$t.power2,
type = "two.sample",
alternative = input$t.alternative2)
# Compute sample sizes (per group)
n1 = ceiling(t1$n)
n2 = t2$n
n2_rct = ceiling(n2 / 2) # n still traditionally randomised in stratified part
# Compute output
n_trad = n1 - n2_rct
n_total = n_trad + n2
n_saved = (n1 + n2) - n_total
n_ind = n1 + n2
# Save output
npRCT.t <- data.frame(n_total = round(n_total),
n_trad = n_trad,
n_saved = n_saved,
n_ind = n_ind)
# Return output
npRCT.t
})
## Chisquare test
npRCT.chisquare <- reactive({
# Run power calculation for first chisquare-test (traditional part of npRCT)
chisq1 <- pwr.chisq.test(w = input$chisquare.w1, sig.level = input$chisquare.sig.level1,
power = input$chisquare.power1,
df = (input$chisquare.k-1)*(input$chisquare.ycat-1))
# Run power calculation for second chisquare-test (stratified part of npRCT)
chisq2 <- pwr.chisq.test(w = input$chisquare.w2, sig.level = input$chisquare.sig.level2,
power = input$chisquare.power2, df = (input$chisquare.ycat-1))
# Compute sample sizes (per group)
n1 = ceiling(chisq1$N / input$chisquare.k)
n2 = chisq2$N / 2
n2_rct = ceiling(n2 / input$chisquare.k) # n still traditionally randomised in stratified part
n_trad = n1 - n2_rct
n_total = ceiling(n_trad + n2)
n_ind = n1 + n2
n_saved = ceiling(n_ind - n_total)
# Save output
npRCT.chisquare <- data.frame(n_total = n_total,
n_trad = n_trad,
n_saved = n_saved,
n_ind = n_ind)
# Return output
npRCT.chisquare
})
## ANOVA
npRCT.anova <- reactive({
# Run power calculation for first t-test (traditional part of npRCT)
anova1 <- pwr.anova.test(k = input$anova.k, f = input$anova.f1,
sig.level = input$anova.sig.level1, power = input$anova.power1)
# Run power calculation for second t-test (stratified part of npRCT)
t2 <- pwr.t.test(d = input$anova.d2, sig.level = input$anova.sig.level2,
power = input$anova.power2, type = input$anova.type2,
alternative = input$anova.alternative2)
# Compute sample sizes (per group)
n1 = ceiling(anova1$n)
n2 = t2$n
n2_rct = ceiling(n2 / input$anova.k) # n still traditionally randomised in stratified part
n_trad = n1 - n2_rct
n_total = n_trad + n2
n_ind = n1 + n2
n_saved = n_ind - n_total
# Save output
npRCT.anova <- data.frame(n_total = round(n_total),
n_trad = n_trad,
n_saved = n_saved,
n_ind = n_ind)
# Return output
npRCT.anova
})
# ---------------Define output as text--------------
## T-test
output$t.n_total <- renderText({
temp <- npRCT.t()
paste("Total npRCT sample size: ",
temp$n_total * 2, sep = "")
})
output$t.n_traditional <- renderText({
temp <- npRCT.t()
paste("Traditional RCT sample size (per group): ",
temp$n_trad, sep = "")
})
output$t.n_precision <- renderText({
temp <- npRCT.t()
paste("Precision RCT sample size (per group): ",
as.character(temp$n_total - temp$n_trad), sep = "")
})
output$t.n_saved <- renderText({
temp <- npRCT.t()
as.character(temp$n_saved)
paste("Using the npRCT design (as compared to two independent RCTs) thus saves a sample size of ",
temp$n_saved, " participants per group.", sep = "")
})
output$twarning <- renderText({
temp <- npRCT.t()
if(temp$n_trad < 20) {
if(temp$n_trad >= 0) {
as.character("Please note that the sample size (per group) of the traditional RCT is relatively small (i.e., smaller than 20). If you aim for online identification of a precision algorithm, you may need to adjust your parameters. Visit the Explanations tab for more insights on practical considerations.")
} else {
as.character("WARNING: You have obtained a negative sample size for the traditional RCT. This occurs, if the to-be-detected effect of the precision RCT is much smaller than for the traditional RCT (i.e., all participants required for testing the traditional research question (intervention A or B) are recruited as part of the precision RCT. If you want to use the npRCT, please adjust parameters accordingly and visit the Explanations tab for more insights on practical considerations.")
}
} else {
as.character("")
}
})
## Chisquare
output$chisquare.n_total <- renderText({
temp <- npRCT.chisquare()
paste("Total npRCT sample size: ",
temp$n_total * 2, sep = "")
})
output$chisquare.n_traditional <- renderText({
temp <- npRCT.chisquare()
paste("Traditional RCT sample size (per group): ",
temp$n_trad, sep = "")
})
output$chisquare.n_precision <- renderText({
temp <- npRCT.chisquare()
paste("Precision RCT sample size (per group): ",
as.character(temp$n_total - temp$n_trad), sep = "")
})
output$chisquare.n_saved <- renderText({
temp <- npRCT.chisquare()
as.character(temp$n_saved)
paste("Using the npRCT design (as compared to two independent RCTs) thus saves a sample size of ",
temp$n_saved, " participants per group.", sep = "")
})
output$chisquarewarning <- renderText({
temp <- npRCT.chisquare()
if(temp$n_trad < 20) {
if(temp$n_trad >= 0) {
as.character("Please note that the sample size (per group) of the traditional RCT is relatively small (i.e., smaller than 20). If you aim for online identification of a precision algorithm, you may need to adjust your parameters. Visit the Explanations tab for more insights on practical considerations.")
} else {
as.character("WARNING: You have obtained a negative sample size for the traditional RCT. This occurs, if the to-be-detected effect of the precision RCT is much smaller than for the traditional RCT (i.e., all participants required for testing the traditional research question (intervention A or B) are recruited as part of the precision RCT. If you want to use the npRCT, please adjust parameters accordingly and visit the Explanations tab for more insights on practical considerations.")
}
} else {
as.character("")
}
})
output$chisquare.k <- renderText({
paste0("Please note that per group refers to main groups of the nested RCTs. For the traditional RCT, this refers to the ", input$chisquare.k , " groups specified using the slider in the box on the right side. For the precision RCT, there always two main groups (i.e., randomised versus stratified to interventions). See the explanations tab for details.")
})
## ANOVA
output$anova.n_total <- renderText({
temp <- npRCT.anova()
paste("Total npRCT sample size: ",
temp$n_total * 2, sep = "")
})
output$anova.n_traditional <- renderText({
temp <- npRCT.anova()
paste("Traditional RCT sample size (per group): ",
temp$n_trad, sep = "")
})
output$anova.n_precision <- renderText({
temp <- npRCT.anova()
paste("Precision RCT sample size (per group): ",
as.character(temp$n_total - temp$n_trad), sep = "")
})
output$anova.n_saved <- renderText({
temp <- npRCT.anova()
as.character(temp$n_saved)
paste("Using the npRCT design (as compared to two independent RCTs) thus saves a sample size of ",
temp$n_saved, " participants per group.", sep = "")
})
output$anovawarning <- renderText({
temp <- npRCT.anova()
if(temp$n_trad < 20) {
if(temp$n_trad >= 0) {
as.character("Please note that the sample size (per group) of the traditional RCT is relatively small (i.e., smaller than 20). If you aim for online identification of a precision algorithm, you may need to adjust your parameters. Visit the Explanations tab for more insights on practical considerations.")
} else {
as.character("WARNING: You have obtained a negative sample size for the traditional RCT. This occurs, if the to-be-detected effect of the precision RCT is much smaller than for the traditional RCT (i.e., all participants required for testing the traditional research question (intervention A or B) are recruited as part of the precision RCT. If you want to use the npRCT, please adjust parameters accordingly and visit the Explanations tab for more insights on practical considerations.")
}
} else {
as.character("")
}
})
output$anova.k <- renderText({
paste0("Please note that per group refers to main groups of the nested RCTs. For the traditional RCT, this refers to the ", input$anova.k , " groups specified using the slider in the box on the right side. For the precision RCT, there always two main groups (i.e., randomised versus stratified to interventions). See the explanations tab for details.")
})
}