diff --git a/docs/news/index.html b/docs/news/index.html index e1bca09..c378b18 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -248,7 +248,7 @@

News

-
+

 
diff --git a/docs/news/posts/2024-12-06-DropoutsDeepdive.html b/docs/news/posts/2024-12-06-DropoutsDeepdive.html index 1b36f7b..18f60eb 100644 --- a/docs/news/posts/2024-12-06-DropoutsDeepdive.html +++ b/docs/news/posts/2024-12-06-DropoutsDeepdive.html @@ -241,46 +241,42 @@

Dropout Per Dose Gu library(shiny) -# Define UI for application that draws a histogram ui <- fluidPage( - # Application title titlePanel("Dropout Per Dose"), - - # Sidebar with a slider input for number of bins sidebarLayout( sidebarPanel( - numericInput("dropoutRate", "Desired Dropout Rate:", value = 0.1), + numericInput("dropoutRate", "Desired Dropout Rate:", value = 0.1, min = 0.0, max = 1.0, step = 0.05), sliderInput("numVisits", "Number of visits:", min = 1, max = 20, value = 5) - ), - - # Show a plot of the generated distribution mainPanel( tableOutput("visitsGuide") ) ) ) -# Define server logic required to draw a histogram server <- function(input, output) { - df = data.frame(Visits = 1:input$numVisits, - ConditionalDropoutRate = 1-(1-input$dropoutRate)^(1/input$numVisits)) - df$TotalDropoutRate = 1-cumprod(1-df$ConditionalDropoutRate) - df$MarginalDropoutRate = c(df$TotalDropoutRate[1], df$TotalDropoutRate[-1] - df$TotalDropoutRate[-n()]) - - df = df[,c("Visits", "ConditionalDropoutRate", "MarginalDropoutRate", "TotalDropoutRate")] - names(df) = c("Visit number", - "Prob. dropout given not dropped before previous visit", - "Prob. dropout between previous visit and current visit", - "Prob. dropout before visit") + output$visitsGuide <- renderTable({ + + if(is.na(input$dropoutRate)) {stop(safeError("Please enter a dropout rate."))} + else if(input$dropoutRate < 0 | input$dropoutRate > 1) {stop(safeError("Dropout rate must be between 0 and 1."))} + else { + df = data.frame(Visits = 1:input$numVisits, + ConditionalDropoutRate = 1-(1-input$dropoutRate)^(1/input$numVisits)) + df$TotalDropoutRate = 1-cumprod(1-df$ConditionalDropoutRate) + df$MarginalDropoutRate = c(df$TotalDropoutRate[1], df$TotalDropoutRate[-1] - df$TotalDropoutRate[-nrow(df)]) - output$visitsGuide <- renderTable(df, digits = 4) + df = df[,c("Visits", "ConditionalDropoutRate", "MarginalDropoutRate", "TotalDropoutRate")] + colnames(df) = c("Visit number", + "Prob. dropout given not dropped before previous visit", + "Prob. dropout between previous visit and current visit", + "Prob. dropout before visit") + df} + }, digits = 4) } -# Run the application shinyApp(ui = ui, server = server) diff --git a/docs/search.json b/docs/search.json index 656b2da..5741ca3 100644 --- a/docs/search.json +++ b/docs/search.json @@ -76,14 +76,14 @@ "href": "news/posts/2024-12-06-DropoutsDeepdive.html", "title": "Dropout Rate Explanation", "section": "", - "text": "For the continuous and dichotomous engines, and the multiple endpoint engine, the default dropout scenario is that no subjects drop out of the study before observing their final endpoint data. If dropouts are expected, the user can specify either the “Dropouts per Dose,” or “Dropouts per Dose per Visit.”\n\n\nIf “Dropouts per Dose” is selected, then each subject has a probability of not having an observable final endpoint value equal to the dropout rate of the dose that subject is randomized to. If each subject has multiple visits and “Dropouts per Dose” is selected, then the conditional probability of dropping out before each visit given that the subject had not dropped out up to the visit before rates are all equal. In other words, if the total dropout rate is π_D, the probability of dropping out between visits i and i+1 given that the subject had not dropped out at visit \\(i\\) is \\[\n1-\\left(1-\\pi_D\\right)^{(\\frac{1}{V})}\\text{ where } V \\text{ is the total number of visits.}\n\\]\n\n\n#| '!! shinylive warning !!': |\n#| shinylive does not work in self-contained HTML documents.\n#| Please set `embed-resources: false` in your metadata.\n#| standalone: true\n#| viewerHeight: 600\n\nlibrary(shiny)\n\n# Define UI for application that draws a histogram\nui <- fluidPage(\n \n # Application title\n titlePanel(\"Dropout Per Dose\"),\n \n # Sidebar with a slider input for number of bins \n sidebarLayout(\n sidebarPanel(\n numericInput(\"dropoutRate\", \"Desired Dropout Rate:\", value = 0.1),\n sliderInput(\"numVisits\", \"Number of visits:\", \n min = 1, max = 20, value = 5)\n \n ),\n \n # Show a plot of the generated distribution\n mainPanel(\n tableOutput(\"visitsGuide\")\n )\n )\n)\n\n# Define server logic required to draw a histogram\nserver <- function(input, output) {\n \n df = data.frame(Visits = 1:input$numVisits,\n ConditionalDropoutRate = 1-(1-input$dropoutRate)^(1/input$numVisits))\n df$TotalDropoutRate = 1-cumprod(1-df$ConditionalDropoutRate)\n df$MarginalDropoutRate = c(df$TotalDropoutRate[1], df$TotalDropoutRate[-1] - df$TotalDropoutRate[-n()])\n \n df = df[,c(\"Visits\", \"ConditionalDropoutRate\", \"MarginalDropoutRate\", \"TotalDropoutRate\")]\n names(df) = c(\"Visit number\",\n \"Prob. dropout given not dropped before previous visit\",\n \"Prob. dropout between previous visit and current visit\",\n \"Prob. dropout before visit\")\n \n output$visitsGuide <- renderTable(df, digits = 4)\n}\n\n# Run the application \nshinyApp(ui = ui, server = server)\n\n\n\n\nIf “Dropouts per Dose per Visit” is selected, then each subject has a user specified probability of dropping out before a visit v that is specified as the conditional probability of dropping out before visit v given that that they had not dropped out by visit v-1. This leads to a total dropout rate π_D for a participant that is equal to:\n\\[\n\\pi_D = 1-\\Pi_{v=0}^V(1-\\pi_v)\n\\]" + "text": "For the continuous and dichotomous engines, and the multiple endpoint engine, the default dropout scenario is that no subjects drop out of the study before observing their final endpoint data. If dropouts are expected, the user can specify either the “Dropouts per Dose,” or “Dropouts per Dose per Visit.”\n\n\nIf “Dropouts per Dose” is selected, then each subject has a probability of not having an observable final endpoint value equal to the dropout rate of the dose that subject is randomized to. If each subject has multiple visits and “Dropouts per Dose” is selected, then the conditional probability of dropping out before each visit given that the subject had not dropped out up to the visit before rates are all equal. In other words, if the total dropout rate is π_D, the probability of dropping out between visits i and i+1 given that the subject had not dropped out at visit \\(i\\) is \\[\n1-\\left(1-\\pi_D\\right)^{(\\frac{1}{V})}\\text{ where } V \\text{ is the total number of visits.}\n\\]\n\n\n#| '!! shinylive warning !!': |\n#| shinylive does not work in self-contained HTML documents.\n#| Please set `embed-resources: false` in your metadata.\n#| standalone: true\n#| viewerHeight: 600\n\nlibrary(shiny)\n\nui <- fluidPage(\n \n titlePanel(\"Dropout Per Dose\"),\n sidebarLayout(\n sidebarPanel(\n numericInput(\"dropoutRate\", \"Desired Dropout Rate:\", value = 0.1, min = 0.0, max = 1.0, step = 0.05),\n sliderInput(\"numVisits\", \"Number of visits:\", \n min = 1, max = 20, value = 5)\n ),\n mainPanel(\n tableOutput(\"visitsGuide\")\n )\n )\n)\n\nserver <- function(input, output) {\n \n output$visitsGuide <- renderTable({\n \n if(is.na(input$dropoutRate)) {stop(safeError(\"Please enter a dropout rate.\"))}\n else if(input$dropoutRate < 0 | input$dropoutRate > 1) {stop(safeError(\"Dropout rate must be between 0 and 1.\"))}\n else {\n df = data.frame(Visits = 1:input$numVisits,\n ConditionalDropoutRate = 1-(1-input$dropoutRate)^(1/input$numVisits))\n df$TotalDropoutRate = 1-cumprod(1-df$ConditionalDropoutRate)\n df$MarginalDropoutRate = c(df$TotalDropoutRate[1], df$TotalDropoutRate[-1] - df$TotalDropoutRate[-nrow(df)])\n \n df = df[,c(\"Visits\", \"ConditionalDropoutRate\", \"MarginalDropoutRate\", \"TotalDropoutRate\")]\n colnames(df) = c(\"Visit number\",\n \"Prob. dropout given not dropped before previous visit\",\n \"Prob. dropout between previous visit and current visit\",\n \"Prob. dropout before visit\")\n df}\n }, digits = 4)\n}\n\nshinyApp(ui = ui, server = server)\n\n\n\n\nIf “Dropouts per Dose per Visit” is selected, then each subject has a user specified probability of dropping out before a visit v that is specified as the conditional probability of dropping out before visit v given that that they had not dropped out by visit v-1. This leads to a total dropout rate π_D for a participant that is equal to:\n\\[\n\\pi_D = 1-\\Pi_{v=0}^V(1-\\pi_v)\n\\]" }, { "objectID": "news/posts/2024-12-06-DropoutsDeepdive.html#dropouts-per-dose", "href": "news/posts/2024-12-06-DropoutsDeepdive.html#dropouts-per-dose", "title": "Dropout Rate Explanation", "section": "", - "text": "If “Dropouts per Dose” is selected, then each subject has a probability of not having an observable final endpoint value equal to the dropout rate of the dose that subject is randomized to. If each subject has multiple visits and “Dropouts per Dose” is selected, then the conditional probability of dropping out before each visit given that the subject had not dropped out up to the visit before rates are all equal. In other words, if the total dropout rate is π_D, the probability of dropping out between visits i and i+1 given that the subject had not dropped out at visit \\(i\\) is \\[\n1-\\left(1-\\pi_D\\right)^{(\\frac{1}{V})}\\text{ where } V \\text{ is the total number of visits.}\n\\]\n\n\n#| '!! shinylive warning !!': |\n#| shinylive does not work in self-contained HTML documents.\n#| Please set `embed-resources: false` in your metadata.\n#| standalone: true\n#| viewerHeight: 600\n\nlibrary(shiny)\n\n# Define UI for application that draws a histogram\nui <- fluidPage(\n \n # Application title\n titlePanel(\"Dropout Per Dose\"),\n \n # Sidebar with a slider input for number of bins \n sidebarLayout(\n sidebarPanel(\n numericInput(\"dropoutRate\", \"Desired Dropout Rate:\", value = 0.1),\n sliderInput(\"numVisits\", \"Number of visits:\", \n min = 1, max = 20, value = 5)\n \n ),\n \n # Show a plot of the generated distribution\n mainPanel(\n tableOutput(\"visitsGuide\")\n )\n )\n)\n\n# Define server logic required to draw a histogram\nserver <- function(input, output) {\n \n df = data.frame(Visits = 1:input$numVisits,\n ConditionalDropoutRate = 1-(1-input$dropoutRate)^(1/input$numVisits))\n df$TotalDropoutRate = 1-cumprod(1-df$ConditionalDropoutRate)\n df$MarginalDropoutRate = c(df$TotalDropoutRate[1], df$TotalDropoutRate[-1] - df$TotalDropoutRate[-n()])\n \n df = df[,c(\"Visits\", \"ConditionalDropoutRate\", \"MarginalDropoutRate\", \"TotalDropoutRate\")]\n names(df) = c(\"Visit number\",\n \"Prob. dropout given not dropped before previous visit\",\n \"Prob. dropout between previous visit and current visit\",\n \"Prob. dropout before visit\")\n \n output$visitsGuide <- renderTable(df, digits = 4)\n}\n\n# Run the application \nshinyApp(ui = ui, server = server)" + "text": "If “Dropouts per Dose” is selected, then each subject has a probability of not having an observable final endpoint value equal to the dropout rate of the dose that subject is randomized to. If each subject has multiple visits and “Dropouts per Dose” is selected, then the conditional probability of dropping out before each visit given that the subject had not dropped out up to the visit before rates are all equal. In other words, if the total dropout rate is π_D, the probability of dropping out between visits i and i+1 given that the subject had not dropped out at visit \\(i\\) is \\[\n1-\\left(1-\\pi_D\\right)^{(\\frac{1}{V})}\\text{ where } V \\text{ is the total number of visits.}\n\\]\n\n\n#| '!! shinylive warning !!': |\n#| shinylive does not work in self-contained HTML documents.\n#| Please set `embed-resources: false` in your metadata.\n#| standalone: true\n#| viewerHeight: 600\n\nlibrary(shiny)\n\nui <- fluidPage(\n \n titlePanel(\"Dropout Per Dose\"),\n sidebarLayout(\n sidebarPanel(\n numericInput(\"dropoutRate\", \"Desired Dropout Rate:\", value = 0.1, min = 0.0, max = 1.0, step = 0.05),\n sliderInput(\"numVisits\", \"Number of visits:\", \n min = 1, max = 20, value = 5)\n ),\n mainPanel(\n tableOutput(\"visitsGuide\")\n )\n )\n)\n\nserver <- function(input, output) {\n \n output$visitsGuide <- renderTable({\n \n if(is.na(input$dropoutRate)) {stop(safeError(\"Please enter a dropout rate.\"))}\n else if(input$dropoutRate < 0 | input$dropoutRate > 1) {stop(safeError(\"Dropout rate must be between 0 and 1.\"))}\n else {\n df = data.frame(Visits = 1:input$numVisits,\n ConditionalDropoutRate = 1-(1-input$dropoutRate)^(1/input$numVisits))\n df$TotalDropoutRate = 1-cumprod(1-df$ConditionalDropoutRate)\n df$MarginalDropoutRate = c(df$TotalDropoutRate[1], df$TotalDropoutRate[-1] - df$TotalDropoutRate[-nrow(df)])\n \n df = df[,c(\"Visits\", \"ConditionalDropoutRate\", \"MarginalDropoutRate\", \"TotalDropoutRate\")]\n colnames(df) = c(\"Visit number\",\n \"Prob. dropout given not dropped before previous visit\",\n \"Prob. dropout between previous visit and current visit\",\n \"Prob. dropout before visit\")\n df}\n }, digits = 4)\n}\n\nshinyApp(ui = ui, server = server)" }, { "objectID": "news/posts/2024-12-06-DropoutsDeepdive.html#dropouts-per-dose-per-visit", diff --git a/news/posts/2024-12-06-DropoutsDeepdive.qmd b/news/posts/2024-12-06-DropoutsDeepdive.qmd index 7aa681d..6a193a5 100644 --- a/news/posts/2024-12-06-DropoutsDeepdive.qmd +++ b/news/posts/2024-12-06-DropoutsDeepdive.qmd @@ -33,46 +33,42 @@ $$ library(shiny) -# Define UI for application that draws a histogram ui <- fluidPage( - # Application title titlePanel("Dropout Per Dose"), - - # Sidebar with a slider input for number of bins sidebarLayout( sidebarPanel( - numericInput("dropoutRate", "Desired Dropout Rate:", value = 0.1), + numericInput("dropoutRate", "Desired Dropout Rate:", value = 0.1, min = 0.0, max = 1.0, step = 0.05), sliderInput("numVisits", "Number of visits:", min = 1, max = 20, value = 5) - ), - - # Show a plot of the generated distribution mainPanel( tableOutput("visitsGuide") ) ) ) -# Define server logic required to draw a histogram server <- function(input, output) { - df = data.frame(Visits = 1:input$numVisits, - ConditionalDropoutRate = 1-(1-input$dropoutRate)^(1/input$numVisits)) - df$TotalDropoutRate = 1-cumprod(1-df$ConditionalDropoutRate) - df$MarginalDropoutRate = c(df$TotalDropoutRate[1], df$TotalDropoutRate[-1] - df$TotalDropoutRate[-n()]) - - df = df[,c("Visits", "ConditionalDropoutRate", "MarginalDropoutRate", "TotalDropoutRate")] - names(df) = c("Visit number", - "Prob. dropout given not dropped before previous visit", - "Prob. dropout between previous visit and current visit", - "Prob. dropout before visit") + output$visitsGuide <- renderTable({ + + if(is.na(input$dropoutRate)) {stop(safeError("Please enter a dropout rate."))} + else if(input$dropoutRate < 0 | input$dropoutRate > 1) {stop(safeError("Dropout rate must be between 0 and 1."))} + else { + df = data.frame(Visits = 1:input$numVisits, + ConditionalDropoutRate = 1-(1-input$dropoutRate)^(1/input$numVisits)) + df$TotalDropoutRate = 1-cumprod(1-df$ConditionalDropoutRate) + df$MarginalDropoutRate = c(df$TotalDropoutRate[1], df$TotalDropoutRate[-1] - df$TotalDropoutRate[-nrow(df)]) - output$visitsGuide <- renderTable(df, digits = 4) + df = df[,c("Visits", "ConditionalDropoutRate", "MarginalDropoutRate", "TotalDropoutRate")] + colnames(df) = c("Visit number", + "Prob. dropout given not dropped before previous visit", + "Prob. dropout between previous visit and current visit", + "Prob. dropout before visit") + df} + }, digits = 4) } -# Run the application shinyApp(ui = ui, server = server) ```