Permalink
Cannot retrieve contributors at this time
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?
npRCT.app/server.R
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
308 lines (199 sloc)
11.9 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # -------------------------------------------------------- | |
| # -----------------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.") | |
| }) | |
| } |