Last active
July 7, 2018 15:20
-
-
Save slackline/5604768 to your computer and use it in GitHub Desktop.
Shiny UI and Server for sample size calculations.
This file contains hidden or 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
| ## Filename server.R | |
| ## Author nshephard@gmail.com | |
| ## Created 2013/05/18 | |
| ## Description Performs sample size calculations | |
| ## Copyright 2013 nshephard@gmail.com | |
| ## | |
| ## This program is free software: you can redistribute it and/or modify | |
| ## it under the terms of the GNU General Public License as published by | |
| ## the Free Software Foundation, either version 3 of the License, or | |
| ## (at your option) any later version. | |
| ## | |
| ## This program is distributed in the hope that it will be useful, | |
| ## but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| ## GNU General Public License for more details. | |
| ## | |
| ## See a <http://www.gnu.org/licenses/> for a copy of the GNU General | |
| ## Public License | |
| # Set up the Server with input and output | |
| shinyServer(function(input, output){ | |
| #################################################################### | |
| ## Perform sample size calculations ## | |
| #################################################################### | |
| data <- reactive({ | |
| require(epicalc) | |
| ## Normal Sample Size Calculations | |
| if(input$design == "Continuous (Means)"){ | |
| mean1 <- input$mean1 | |
| sd1 <- input$sd1 | |
| mean2 <- input$mean2 | |
| sd2 <- input$sd2 | |
| power <- input$power | |
| step <- input$step | |
| alpha <- input$alpha | |
| ## paired <- input$paired | |
| ratio <- input$ratio | |
| cluster <- input$cluster | |
| icc <- input$icc | |
| mean.cluster.size <- input$mean.cluster.size | |
| min.cluster.size <- input$min.cluster.size | |
| max.cluster.size <- input$max.cluster.size | |
| ## Calculate some parameters to control simulations | |
| diff <- abs(mean1 - mean2) | |
| mean1.min = mean1 - (diff / 2) | |
| mean1.max = mean1 + (diff / 2) | |
| ## if(cluster == FALSE){ | |
| ## TODO - work out how to get these assessed correctly & directly within mapply() | |
| sample.sizes <- data.frame(expand.grid(power = seq(power[1], power[2], by = step), | |
| mean1 = seq(mean1.min, mean1.max, by = diff / 100), | |
| mean2 = mean2, | |
| sd1 = sd1, | |
| sd2 = sd2, | |
| alpha = alpha, | |
| ratio = ratio)) | |
| sample.sizes <- as.data.frame(t(mapply(n.for.2means, | |
| mu1 = sample.sizes$mean1, | |
| mu2 = sample.sizes$mean2, | |
| sd1 = sample.sizes$sd1, | |
| sd2 = sample.sizes$sd2, | |
| ratio = sample.sizes$ratio, | |
| alpha = sample.sizes$alpha, | |
| power = sample.sizes$power / 100))) | |
| ## } | |
| ## else{ | |
| ## sample.sizes <- data.frame(expand.grid(power = seq(power[1], power[2], by = step), | |
| ## mean1 = seq(mean1.min, mean1.max, by = diff / 100), | |
| ## mean2 = mean2, | |
| ## sd1 = sd1, | |
| ## sd2 = sd2, | |
| ## alpha = alpha, | |
| ## ratio = ratio, | |
| ## icc = icc, ## Possibly expand this to three or four ICC? | |
| ## mean.cluster.size = mean.cluster.size, | |
| ## min.cluster.size = min.cluster.size, | |
| ## max.cluster.size = max.cluster.size)) | |
| ## sample.sizes <- as.data.frame(t(mapply(n.for.cluster.2means, | |
| ## mu1 = sample.sizes$mean1, | |
| ## mu2 = sample.sizes$mean2, | |
| ## sd1 = sample.sizes$sd1, | |
| ## sd2 = sample.sizes$sd2, | |
| ## ratio = sample.sizes$ratio, | |
| ## alpha = sample.sizes$alpha, | |
| ## power = sample.sizes$power / 100, | |
| ## icc = sample.sizes$icc, | |
| ## mean.cluster.size = sample.sizes$mean.cluster.size, | |
| ## min.cluster.size = sample.sizes$min.cluster.size, | |
| ## max.cluster.size = sample.sizes$max.cluster.size))) | |
| ## } | |
| sample.sizes <- subset(as.data.frame(sample.sizes), | |
| select = -c(table)) | |
| ## Convert to numeric (not sure why this isn't already the case?) | |
| for(x in names(sample.sizes)){ | |
| sample.sizes[[x]] <- as.numeric(sample.sizes[[x]]) | |
| } | |
| ## Calculate a few other numbers | |
| sample.sizes$diff <- abs(sample.sizes$mu1 - sample.sizes$mu2) | |
| sample.sizes$N <- sample.sizes$n1 + sample.sizes$n2 | |
| sample.sizes | |
| } | |
| ## Binary Sample Size Calculations | |
| else if(input$design == "Binary (Proportions)"){ | |
| p1 <- input$p1 | |
| p2 <- input$p2 | |
| power <- input$power | |
| step <- input$step | |
| alpha <- input$alpha | |
| paired <- input$paired | |
| ratio <- input$ratio | |
| cluster <- input$cluster | |
| icc <- input$icc | |
| mean.cluster.size <- input$mean.cluster.size | |
| min.cluster.size <- input$min.cluster.size | |
| max.cluster.size <- input$max.cluster.size | |
| ## Calculate some parameters to control simulations | |
| diff <- abs(p1 - p2) | |
| p1.min = p1 - (diff / 2) | |
| p1.max = p1 + (diff / 2) | |
| if(cluster == FALSE){ | |
| sample.sizes <- data.frame(expand.grid(p1 = seq(p1.min, p1.max, by = diff / 100), | |
| p2 = p2, | |
| ratio = ratio, | |
| alpha = alpha, | |
| power = seq(power[1], power[2], by = step))) | |
| sample.sizes <- t(mapply(n.for.2p, | |
| p1 = sample.sizes$p1, | |
| p2 = sample.sizes$p2, | |
| ratio = sample.sizes$ratio, | |
| alpha = sample.sizes$alpha, | |
| power = sample.sizes$power / 100)) | |
| sample.sizes <- subset(as.data.frame(sample.sizes), | |
| select = -c(table)) | |
| } | |
| else{ | |
| sample.sizes <- data.frame(expand.grid(p1 = seq(p1.min, p1.max, by = step), | |
| p2 = p2, | |
| ratio = ratio, | |
| alpha = alpha, | |
| power = seq(power[1], power[2], by = step), | |
| mean.cluster.size = mean.cluster.size, | |
| min.cluster.size = min.cluster.size, | |
| max.cluster.size = max.cluster.size)) | |
| sample.sizes <- t(mapply(n.for.cluster.2p, | |
| p1 = sample.sizes$p1, | |
| p2 = sample.sizes$p2, | |
| ratio = sample.sizes$ratio, | |
| alpha = sample.sizes$alpha, | |
| power = sample.sizes$power / 100, | |
| icc = sample.sizes$icc, | |
| mean.cluster.size = sample.sizes$mean.cluster.size, | |
| min.cluster.size = sample.sizes$min.cluster.size, | |
| max.cluster.size = sample.sizes$max.cluster.size)) | |
| } | |
| ## Convert to numeric (not sure why this isn't already the case?) | |
| for(x in names(sample.sizes)){ | |
| sample.sizes[[x]] <- as.numeric(sample.sizes[[x]]) | |
| } | |
| ## Calculate a few other numbers | |
| sample.sizes$diff <- abs(sample.sizes$p1 - sample.sizes$p2) | |
| sample.sizes$N <- sample.sizes$n1 + sample.sizes$n2 | |
| } | |
| ## Non-Inferior Sample Size Calculations | |
| else if(input$design == "Non-Inferiority (Proportions)"){ | |
| p <- input$p | |
| sig.inferior <- input$p - input$sig.inferior | |
| power <- input$power | |
| step <- input$step | |
| alpha <- input$alpha | |
| ## Calculate some parameters to control simulations | |
| min = p + 0.001 | |
| if(min < 0) min <- 0.001 | |
| max = p + (sig.inferior * 2) | |
| if(max > 0.5) max <- 0.5 | |
| sample.sizes <- data.frame(expand.grid(p = p, | |
| sig.inferior = seq(min, max, by = 0.01), | |
| alpha = alpha, | |
| power = seq(power[1], power[2], by = step))) | |
| sample.sizes <- t(mapply(n.for.noninferior.2p, | |
| p = sample.sizes$p, | |
| sig.inferior = sample.sizes$sig.inferior, | |
| alpha = sample.sizes$alpha, | |
| power = sample.sizes$power / 100)) | |
| sample.sizes <- subset(as.data.frame(sample.sizes), | |
| select = -c(table)) | |
| ## Convert to numeric (not sure why this isn't already the case?) | |
| for(x in names(sample.sizes)){ | |
| sample.sizes[[x]] <- as.numeric(sample.sizes[[x]]) | |
| } | |
| ## Calculate a few other numbers | |
| sample.sizes$diff <- abs(sample.sizes$p - sample.sizes$sig.inferior) | |
| sample.sizes$N <- 2 * sample.sizes$n | |
| } | |
| sample.sizes | |
| }) | |
| #################################################################### | |
| ## Plot the results ## | |
| #################################################################### | |
| output$plot <- renderPlot({ | |
| require(ggplot2) | |
| t <- ggplot(data(), aes(x = diff, y = N, color = as.factor(power))) | |
| t <- t + stat_smooth(method = "loess", se = FALSE) + | |
| ylab("N (Total)") + xlab("Difference") + | |
| ggtitle("Sample Size for varying Power") + | |
| scale_color_discrete(name = "Power") | |
| print(t) | |
| }) | |
| #################################################################### | |
| ## Generate table of results ## | |
| #################################################################### | |
| output$table <- renderTable({ | |
| data.frame(data()) | |
| }) | |
| #################################################################### | |
| ## Generate downloadable dataset ## | |
| #################################################################### | |
| output$download <- downloadHandler({ | |
| filename = function() { paste('sample_size', '.csv', sep='') } | |
| content = function(file) { | |
| write.csv(data(), file) | |
| } | |
| }) | |
| }) |
This file contains hidden or 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
| ## Filename ui.R | |
| ## Author nshephard@gmail.com | |
| ## Created 2013/05/18 | |
| ## Description Sets up a web page using Shiny to perform sample | |
| ## size calculations for continuous, normally | |
| ## distributed outcomes. | |
| ## Copyright 2013 nshephard@gmail.com | |
| ## | |
| ## This program is free software: you can redistribute it and/or modify | |
| ## it under the terms of the GNU General Public License as published by | |
| ## the Free Software Foundation, either version 3 of the License, or | |
| ## (at your option) any later version. | |
| ## | |
| ## This program is distributed in the hope that it will be useful, | |
| ## but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| ## GNU General Public License for more details. | |
| ## | |
| ## See a <http://www.gnu.org/licenses/> for a copy of the GNU General | |
| ## Public License | |
| . | |
| library(shiny) | |
| ## Define UI | |
| shinyUI(pageWithSidebar( | |
| ## Application title | |
| headerPanel("Sample Size Calculations for Differences in Means"), | |
| ## Sidebar with controls | |
| sidebarPanel( | |
| ## Select type of Sample Size calculations | |
| selectInput("design", "Study Design", | |
| choices = c("Continuous (Means)", | |
| "Binary (Proportions)", | |
| "Non-Inferiority (Proportions)") | |
| ), | |
| ## Power (Beta) | |
| sliderInput("power", | |
| "Power :", | |
| min = 75, | |
| max = 100, | |
| step = 1, | |
| value = c(80, 95)), | |
| numericInput("step", "Increments for Power Calculations", 5, step = 1), | |
| ## Significance | |
| sliderInput("alpha", | |
| "Significance : ", | |
| min = 0.001, | |
| max = 0.1, | |
| step = 0.005, | |
| value = 0.05), | |
| ## Normal | |
| conditionalPanel( | |
| condition = "input.design == 'Continuous (Means)'", | |
| numericInput("mean1", "Mean in Control Group :", 0, step = 0.01), | |
| numericInput("sd1", "SD in Control Group :", 1, step = 0.01), | |
| numericInput("mean2", "Mean in Treatment Group :", 1, step = 0.01), | |
| numericInput("sd2", "SD in Treatment Group :", 1, step = 0.01), | |
| sliderInput("ratio", | |
| "Allocation Ratio (1:N) :", | |
| min = 1, | |
| max = 10, | |
| step = 1, | |
| value = 1) | |
| ## Currently not an option in the epicalc n.for.2means() | |
| ##checkboxInput("paired", "Paired Study Design?", FALSE), | |
| ), | |
| ## Binary | |
| conditionalPanel( | |
| condition = "input.design == 'Binary (Proportions)'", | |
| numericInput("p1", "Proportion in Control Group :", | |
| value = 0.1, | |
| min = 0, | |
| max = 1, | |
| step = 0.001), | |
| numericInput("p2", "Proportion in Treatment Group :", | |
| value = 0.2, | |
| min = 0, | |
| max = 1, | |
| step = 0.001), | |
| sliderInput("ratio", | |
| "Allocation Ratio (1:N) :", | |
| min = 1, | |
| max = 10, | |
| step = 1, | |
| value = 1) | |
| ), | |
| ## Non-Inferiority | |
| conditionalPanel( | |
| condition = "input.design == 'Non-Inferiority (Proportions)'", | |
| numericInput("p", "Proportion :", | |
| value = 0.1, | |
| min = 0, | |
| max = 1, | |
| step = 0.001), | |
| sliderInput("sig.inferior", | |
| "Level of reduction of effectiveness as being clinically significant :", | |
| min = 0, | |
| max = 1, | |
| step = 0.001, | |
| value = 0.05) | |
| ), | |
| ## Cluster Study Design | |
| checkboxInput("cluster", "Cluster Study Design?", FALSE), | |
| conditionalPanel( | |
| condition = "input.cluster == true", | |
| numericInput("mean.cluster.size", "Mean Cluster Size", 10, step = 1), | |
| numericInput("min.cluster.size", "Minimum Cluster Size", 2, step = 1), | |
| numericInput("max.cluster.size", "Maximum Cluster Size", 30, step = 1), | |
| sliderInput("cluster.range", | |
| "Cluster Size Range", | |
| min = 2, | |
| max = 200, | |
| step = 1, | |
| value = c(5, 20)), | |
| sliderInput("icc", | |
| "Interclass Correlation", | |
| min = 0.001, | |
| max = 1, | |
| step = 0.005, | |
| value = 0.05) | |
| ) | |
| ), | |
| ## Main Panel of graphical display | |
| mainPanel( | |
| tabsetPanel( | |
| tabPanel("Plot", plotOutput("plot")), | |
| tabPanel("Table", downloadButton('downloadData', "Download"), tableOutput("table")) | |
| ) | |
| ) | |
| )) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment