R Shiny - why are updates not immediate after changing sliders and inputs? - r

I'm creating a version of a sample size and power calculator. After running the code, when selecting the option "Sample Size", any updates to the sample size are immediate after moving around sliders or other numeric Inputs. However for the option "Power" (both coming from the first "selectInput" option), updates are not immediate if at all occurring.
I'm not sure if the correct move forward is to use a reactive expression.
library(shiny)
library(pwr)
ui <- fluidPage(
titlePanel("Sample Size and Power Calculator"),
sidebarLayout(
sidebarPanel(
#What are we calculating?
selectInput(inputId = "type",
label = strong("Calculator Options"),
choices = c("Pick an Option",
"Power",
"Sample Size"),
selected = "Pick an Option"),
#Display only if Sample Size is selected, ask for necessary parameters
conditionalPanel(
condition = "input.type == 'Sample Size'",
#1. Standard Deviation
numericInput(inputId = "stddev",
label = "Standard Deviation",
value = 10,
min = 1,
max = 400,
step = 1),
#2. Power
sliderInput(inputId = "power",
label = "Power of Study",
min = 0.5,
max = 0.99,
value = 0.8,
step = 0.01),
h6("Power as a decimal not percentage."),
h6("(0.8 means 80% power)"),
#3. Alpha (Significance)
sliderInput(inputId = "alpha",
label = "Significance of Study",
min = 0.01,
max = 0.2,
value = 0.05,
step = 0.01),
h6("Significance of study is most traditionally 0.05 (5%)"),
#4. Meandiff (Difference Between Groups)
numericInput(inputId = "meandiff",
label = "Expected Difference Between Group Means",
value = 20),
#5. Alternative Test
selectInput(inputId = "alt",
label = strong("Alternative Test Options"),
choices = c("Two-Sided" = "two.sided",
"Upper" = "greater",
"Lower" = "less"),
selected = "Two-Sided"),
h6("If unsure, leave at 'Two-Sided'.")
),
#Display only if Power is selected, ask for necessary parameters
conditionalPanel(
condition = "input.type == 'Power'",
#1. Standard Deviation
numericInput(inputId = "stddev",
label = "Standard Deviation",
value = 10,
min = 1,
max = 400,
step = 1),
#2. Size Per Group
numericInput(inputId = "npergroup",
label = "Number per Group",
value = 120),
h6("Assuming equal number in each group, enter number for ONE group."),
#3. Alpha (Significance)
sliderInput(inputId = "alpha",
label = "Significance of Study",
min = 0.01,
max = 0.2,
value = 0.05,
step = 0.01),
h6("Significance of study is most traditionally 0.05 (5%)"),
#4. Meandiff (Difference Between Groups)
numericInput(inputId = "meandiff",
label = "Expected Difference Between Group Means",
value = 20),
#5. Alternative Test
selectInput(inputId = "alt",
label = strong("Alternative Test Options"),
choices = c("Two-Sided" = "two.sided",
"Upper" = "greater",
"Lower" = "less"),
selected = "Two-Sided"),
h6("If unsure, leave at 'Two-Sided'.")
)
),
#Output:
mainPanel(
textOutput(outputId = "intro"),
textOutput(outputId = "desc"),
conditionalPanel(
condition = "input.type == 'Sample Size'",
textOutput(outputId = "samplesize")
),
conditionalPanel(
condition = "input.type == 'Power'",
textOutput(outputId = "power")
)
)
)
)
server <- function(input, output) {
#Introductory Text
output$intro <- renderText({
"Select an option and adjust the sliders and parameters."
})
#Description of what has been chosen
output$desc <- renderText({
paste("You chose: ", input$type)
})
#If Sample Size is selected, what is the sample size
output$samplesize <- renderText({
paste("Sample Size Per Group for Two-Sample t-test for Mean Diff
Assuming Two Groups and Equal Variances: ",
as.character(ceiling(pwr.t.test(d = input$meandiff / input$stddev,
sig.level = input$alpha,
power = input$power,
type = "two.sample",
alternative = input$alt)$n)))
})
#If Power is selected, what is the power
output$power <- renderText({
paste("Power for Two-Sample t-test for Mean Diff Assuming Two Groups and
Equal Variances: ",
format(round(pwr.t.test(d = input$meandiff / input$stddev,
sig.level = input$alpha,
n = input$npergroup,
type = "two.sample",
alternative = input$alt)$power * 100, 2),
nsmall = 2))
})
}
shinyApp(ui = ui, server = server)

It would be ideal that all the input ids are unique. Below I added 2 for those duplicated input ids. All of them are in the power analysis. After this change, the code works.
library(shiny)
library(pwr)
ui <- fluidPage(
titlePanel("Sample Size and Power Calculator"),
sidebarLayout(
sidebarPanel(
#What are we calculating?
selectInput(inputId = "type",
label = strong("Calculator Options"),
choices = c("Pick an Option",
"Power",
"Sample Size"),
selected = "Pick an Option"),
#Display only if Sample Size is selected, ask for necessary parameters
conditionalPanel(
condition = "input.type == 'Sample Size'",
#1. Standard Deviation
numericInput(inputId = "stddev",
label = "Standard Deviation",
value = 10,
min = 1,
max = 400,
step = 1),
#2. Power
sliderInput(inputId = "power",
label = "Power of Study",
min = 0.5,
max = 0.99,
value = 0.8,
step = 0.01),
h6("Power as a decimal not percentage."),
h6("(0.8 means 80% power)"),
#3. Alpha (Significance)
sliderInput(inputId = "alpha",
label = "Significance of Study",
min = 0.01,
max = 0.2,
value = 0.05,
step = 0.01),
h6("Significance of study is most traditionally 0.05 (5%)"),
#4. Meandiff (Difference Between Groups)
numericInput(inputId = "meandiff",
label = "Expected Difference Between Group Means",
value = 20),
#5. Alternative Test
selectInput(inputId = "alt",
label = strong("Alternative Test Options"),
choices = c("Two-Sided" = "two.sided",
"Upper" = "greater",
"Lower" = "less"),
selected = "Two-Sided"),
h6("If unsure, leave at 'Two-Sided'.")
),
#Display only if Power is selected, ask for necessary parameters
conditionalPanel(
condition = "input.type == 'Power'",
#1. Standard Deviation
numericInput(inputId = "stddev2",
label = "Standard Deviation",
value = 10,
min = 1,
max = 400,
step = 1),
#2. Size Per Group
numericInput(inputId = "npergroup",
label = "Number per Group",
value = 120),
h6("Assuming equal number in each group, enter number for ONE group."),
#3. Alpha (Significance)
sliderInput(inputId = "alpha2",
label = "Significance of Study",
min = 0.01,
max = 0.2,
value = 0.05,
step = 0.01),
h6("Significance of study is most traditionally 0.05 (5%)"),
#4. Meandiff (Difference Between Groups)
numericInput(inputId = "meandiff2",
label = "Expected Difference Between Group Means",
value = 20),
#5. Alternative Test
selectInput(inputId = "alt2",
label = strong("Alternative Test Options"),
choices = c("Two-Sided" = "two.sided",
"Upper" = "greater",
"Lower" = "less"),
selected = "Two-Sided"),
h6("If unsure, leave at 'Two-Sided'.")
)
),
#Output:
mainPanel(
textOutput(outputId = "intro"),
textOutput(outputId = "desc"),
conditionalPanel(
condition = "input.type == 'Sample Size'",
textOutput(outputId = "samplesize")
),
conditionalPanel(
condition = "input.type == 'Power'",
textOutput(outputId = "power")
)
)
)
)
server <- function(input, output) {
#Introductory Text
output$intro <- renderText({
"Select an option and adjust the sliders and parameters."
})
#Description of what has been chosen
output$desc <- renderText({
paste("You chose: ", input$type)
})
#If Sample Size is selected, what is the sample size
output$samplesize <- renderText({
paste("Sample Size Per Group for Two-Sample t-test for Mean Diff
Assuming Two Groups and Equal Variances: ",
as.character(ceiling(pwr.t.test(d = input$meandiff / input$stddev,
sig.level = input$alpha,
power = input$power,
type = "two.sample",
alternative = input$alt)$n)))
})
#If Power is selected, what is the power
output$power <- renderText({
paste("Power for Two-Sample t-test for Mean Diff Assuming Two Groups and
Equal Variances: ",
format(round(pwr.t.test(d = input$meandiff2 / input$stddev2,
sig.level = input$alpha2,
n = input$npergroup,
type = "two.sample",
alternative = input$alt2)$power * 100, 2),
nsmall = 2))
})
}
shinyApp(ui = ui, server = server)

Related

Shiny feedbackDanger doesnt work inside eventReactive where function is called

I am begginer in shiny an I am stucked adding feedback in my app.
I have tried a few things like write this code inside the eventReactive function like use the function feedBackDanger.
Below, there is a simplified full code with the ui, the idea is that i need the user get some Error (but not the console Error) if he set 'zero' in kind variable when mean is 3,6 or 9.
Also the actionButton 'simulate' should be disable when this condition is selected.
ui <- shinyUI(fluidPage(
titlePanel(h1("Simulation", align = 'center')),
sidebarLayout(
sidebarPanel(
numericInput(inputId = "n", label = "Size of Sample", min = 1,
step = 1, value = 1),
numericInput(inputId = "mean", label = "Mean of Sample", min = 1,
step = 1, value = 1),
numericInput(inputId = "var", label = "Variance", min = 1,
step = 0.25, value = 1),
radioButtons("kind", "Sample kind", choices = c("two", "zero")),
actionButton("simulate", "Simulate"),
width = 200
),
mainPanel(
plotOutput("distPlot", width = 500, height = 500)
)
)
))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output, session) {
s_fin <-function(n,
mean,
var,
kind){
a <- rnorm(n, mean, var)
if(kind == 'two'){
a <- a + 2
}
if(kind == 'zero'& mean %in% c(3,6,9)){
print('ERROR: function error')
stop(call. = T)}
return(a)
}
simulation <- eventReactive(input$simulate,{
s_fin(n = input$n,
mean = input$mean,
var = input$var,
kind = input$kind)
})
output$distPlot <- renderPlot({
hist(simulation())
})
})
shinyApp(ui, server)
The next code works to me (a just add useShinyFeedback() in ui.R, and put the error function instead of print):
library(shinyFeedback)
ui <- shinyUI(fluidPage(
useShinyFeedback(),
titlePanel(h1("Simulation", align = 'center')),
sidebarLayout(
sidebarPanel(
numericInput(inputId = "n", label = "Size of Sample", min = 1,
step = 1, value = 1),
numericInput(inputId = "mean", label = "Mean of Sample", min = 1,
step = 1, value = 1),
numericInput(inputId = "var", label = "Variance", min = 1,
step = 0.25, value = 1),
radioButtons("kind", "Sample kind", choices = c("two", "zero")),
actionButton("simulate", "Simulate"),
width = 200
),
mainPanel(
plotOutput("distPlot", width = 500, height = 500)
)
)
))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output, session) {
s_fin <-function(n,
mean,
var,
kind){
a <- rnorm(n, mean, var)
if(kind == 'two'){
a <- a + 2
}
if(kind == 'zero'& mean %in% c(3,6,9)){
showFeedbackDanger(
inputId = "mean",
text = "Not use mean 3, 6 or 9"
)
shinyjs::disable("simulate")
}else{
hideFeedback("mean")
shinyjs::enable("simulate")
}
return(a)
}
simulation <- eventReactive(input$simulate,{
s_fin(n = input$n,
mean = input$mean,
var = input$var,
kind = input$kind)
})
output$distPlot <- renderPlot({
hist(simulation())
})
})
shinyApp(ui, server)

R Shiny Application moving graph location

I'm currently building an application in R-Shiny and having troubles with the location of the graph since I've added tabs to the application. I want to move the graph from the first tab from below the inputs to the right of them. I'm currently getting the following message from R.
bootstrapPage(position =) is deprecated as of shiny 0.10.2.2. The 'position' argument is no longer used with the latest version of Bootstrap. Error in tabsetPanel(position = "right", tabPanel("Drawdown Plot", plotOutput("line"), : argument is missing, with no default
Any help would be greatly appreciated! Code is below
ui <- fluidPage(
titlePanel("Drawdown Calculator"),
theme = bs_theme(version = 4, bootswatch = "minty"),
sidebarPanel(
numericInput(inputId = "pot",
label = "Pension Pot",
value = 500000, min = 0, max = 2000000, step = 10000),
numericInput(inputId = "with",
label = "Withdrawal Amount",
value = 40000, min = 0, max = 200000, step = 1000),
numericInput(inputId = "age",
label = "Age", value = 65, max = 90, min = 40),
sliderInput(inputId = "int",
label = "Interest",
value = 4, max = 15, min = 0, step = 0.1)),
mainPanel(
tabsetPanel(position = "right",
tabPanel("Drawdown Plot", plotOutput("line"),
p("This drawdown calculator calculates a potential drawdown outcome")),
tabPanel ("Breakdown of Drawdown Withdrawals",
tableOutput("View")),
))
)
Try this code -
library(shiny)
library(bslib)
ui <- fluidPage(
titlePanel("Drawdown Calculator"),
theme = bs_theme(version = 4, bootswatch = "minty"),
sidebarPanel(
numericInput(inputId = "pot",
label = "Pension Pot",
value = 500000, min = 0, max = 2000000, step = 10000),
numericInput(inputId = "with",
label = "Withdrawal Amount",
value = 40000, min = 0, max = 200000, step = 1000),
numericInput(inputId = "age",
label = "Age", value = 65, max = 90, min = 40),
sliderInput(inputId = "int",
label = "Interest",
value = 4, max = 15, min = 0, step = 0.1)),
mainPanel(
tabsetPanel(
tabPanel("Drawdown Plot",
p("This drawdown calculator calculates a potential drawdown outcome"),
tableOutput("View")),
tabPanel("Breakdown of Drawdown Withdrawals",
plotOutput("line"))
))
)
server <- function(input, output) {}
shinyApp(ui, server)

update values in numericInput R shiny

I have an app wherein users can input numeric values for certain fields (using numericInput()). Alternatively, they can choose to select values from a reference table (via a checkboxInput() field).
I'm able to code this behaviour in the script properly. But I also want that if the checkboxInput field is selected, the values displayed in the numericInput() get updated i.e. the default values or previously written values are overwritten.
In the screenshot, the numericInput fields are highlighted in yellow. The top field has a default value of 14 whereas the others are empty. I want that the if the "Copy reference values?" checkboxInput is selected, the copied values get displayed in the corresponding fields (k1 = 72.49 for "Flow Coef. for dP" etc.)
My code is as below:
fluidRow(
column(4,
numericInput(inputId = "Area",
label = tags$div(HTML(paste("rea (m", tags$sup(2), ")", sep = ""))),
min = 1, max = 100, step = 0.1, value = 14),
numericInput(inputId = "k1", label = "Flow coef. for dP", min = 1.0, max = 600.0, value = ""),
numericInput(inputId = "k2", label = "Flow exponent for dP" , min = 1.0, max = 20.0, value = "")
checkboxInput("copyVals", "Copy Reference Values?", value = FALSE)
)
You'll want to use an observeEvent and updateNumericInputs. Since you didn't provide a reproducible example here is a mockup:
library("shiny")
library("DT")
data <- data.frame(area = 18.61, k1 = 74.29, k2 = 1.44)
server <- function(input, output, session) {
# assuming your data is reactive, not static
data_reac <- reactive({
data
})
output$parm_tab <- renderDataTable({
datatable(data_reac())
})
# set the values if checked
observeEvent(input$copyVals == TRUE, {
c_data <- data_reac()
updateNumericInput(session, "area", value = c_data$area)
updateNumericInput(session, "k1", value = c_data$k1)
updateNumericInput(session, "k2", value = c_data$k2)
}, ignoreInit = TRUE)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput(inputId = "area", label = "Area", min = 1, max = 100, step = 0.1, value = 14),
numericInput(inputId = "k1", label = "Flow coef. for dP", min = 1.0, max = 600.0, value = ""),
numericInput(inputId = "k2", label = "Flow exponent for dP" , min = 1.0, max = 20.0, value = ""),
checkboxInput("copyVals", "Copy Reference Values?", value = FALSE)
)
, mainPanel(
dataTableOutput("parm_tab")
)
)
)
shinyApp(ui = ui, server = server)
Before
After

RShiny reactive error

I am building a simple RShiny App that calculates sample size and power, but I keep getting this error message---
Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
I couldn't figure out how to fix it. This is my first time using RShiny. If anyone can help, I really appreciate that! Thanks a lot!
library(shiny)
ui <- fluidPage(
headerPanel("Power and Sample Size Calculator"),
fluidRow(column(12,
wellPanel(
helpText("Two proportions (equal sample size in each group) power/sample size analysis"),
selectInput (inputId = "choice",
label = " Please Choose What You Want To Calculate",
c("Power","Sample Size"),selected = NULL,
multiple = FALSE,
selectize = TRUE, width = NULL, size = NULL)
)),
column(4,
wellPanel(
conditionalPanel(
condition = "input$choice = Power",
numericInput (inputId = "tau",
label = "Effect Size",
value = "0.2",
min = 0, max =1),
numericInput (inputId = "n",
label = "Sample Size in Each Group",
value = "200",
min = 0,
max = 100000000),
sliderInput (inputId = "alpha",
label = "Significance Level ⍺= ",
value = "0.05",
min = 0.001, max = 0.10)),
conditionalPanel(
condition = "input$choice=Sample Size",
numericInput (inputId = "tau",
label = "Effect Size",
value = "0.2",
min = 0, max =1),
sliderInput (inputId = "alpha",
label = "Significance Level ⍺= ",
value = "0.05",
min = 0.001, max = 0.10),
numericInput (inputId = "beta",
label = "Power",
value = "0.8",
min = 0,
max = 1))
)
),
column(8,
wellPanel(
htmlOutput("Result")
))
))
server <- function(input, output) {
choice <- switch (input$choice,
"Power" = 1, "Sample Size" = 2)
output$Result <- renderUI({
if(choice==1){
final=reactive({pwr.2p.test(h = input$tau, n = input$n, sig.level = input$alpha, power = )
})
}
if(choice==2){
final=reactive({pwr.2p.test(h = input$tau, n = , sig.level = input$alpha, power = input$beta)
})}
HTML(final)
}
)
}
shinyApp(ui=ui, server=server)
I don't think it is required to have reactive for final. try this below.
it works for me, except for pwr.2p.test, looks like that is some function you are trying to use. Also, I did not understand why you had HTML(final), use of renderUishould generate html by default. Let me know how did it go. Good luck
server <- function(input, output) {
choice <- reactive({
switch(input$choice,"Power" = 1,"Sample Size" = 2)})
output$Result <- renderUI({
if (input$choice == 'Power') {
pwr.2p.test( h = input$tau,
n = input$n,
sig.level = input$alpha,
power = input$beta
)}
if (input$choice == 'Sample Size') {
pwr.2p.test( h = input$tau,
n = ,
sig.level = input$alpha,
power = input$beta
)}
})
}

Unable to figure out how to create and run my user-defined R function in Shiny with input text boxes

I've an R script for which I need to develop and intigrate a user-interface in shiny package in R.
My following is a part of R code that I'm trying to build the interface around:
# A random normal function to generate numbers with exact mean and SD
rnorm2 <- function(n,mean,sd) { mean+sd*scale(rnorm(n)) }
age <- rnorm2(n = 10000, mean = 55 , sd = 15)
cholestrol <- rnorm2(n = 10000, mean = 200 , sd = 30)
bp <- rnorm2(n = 10000, mean = 90 , sd = 25)
df <- cbind(age, cholestrol,bp)
Org_Data <- as.data.frame(df)
As there are 9 inputs (3 each for age, cholestrol and bp) I've created 9 input boxes in which user enters the input and then on a button click I want to run the rnorm2 function that I created.
My shiny app code is as follows:
ui.R:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("function1"),
sidebarPanel(
#Age input
textInput(inputId = "n1",
label = h4("Enter n for Age:"),
value = ""),
textInput(inputId = "mean1",
label = h4("Enter mean for Age:"),
value = ""),
textInput(inputId = "sd1",
label = h4("Enter sd for Age:"),
value = ""),
#Cholestrol input
textInput(inputId = "n1",
label = h4("Enter n for Cholestrol:"),
value = ""),
textInput(inputId = "mean1",
label = h4("Enter mean for Cholestrol:"),
value = ""),
textInput(inputId = "sd1",
label = h4("Enter sd for Cholestrol:"),
value = ""),
#Blood Pressure input
textInput(inputId = "n1",
label = h4("Enter n for Blood Pressure:"),
value = ""),
textInput(inputId = "mean1",
label = h4("Enter mean for Blood Pressure:"),
value = ""),
textInput(inputId = "sd1",
label = h4("Enter sd for Blood Pressure:"),
value = ""),
actionButton(inputId = "input_action", label = "Show Inputs")),
mainPanel(
h2("Input Elements"), # title with HTML helper
textOutput("td"))
))
But I'm completely helpless at figuring out how to put the R code I mentioned at the beginning into the server.R file. Can I start with simply defining the function?? And then how to run that function on those inputs taken from the user and then save the output into each of theose variables: age, cholestrol and bp???
server.R:
library(shiny)
#defining a function
rnorm2 <- function(n,mean,sd) { mean+sd*scale(rnorm(n)) }
shinyServer(function(input, output){
#Don't know how run the function and save the output into the variables
age <-
cholestrol <-
bp <-
})
})
This is my first day with shiny and all the server.R code samples on the internet are kinda going over my head. But I really need to turn this around today. Please help!!!
The only dependency I added was library(DT) which is an exceptionally useful package.
You'll notice that you needed to make your input ids unique in the ui.R and use an eventReactive to instruct shiny to wait for the input button.
ui.R
library(shiny)
library(DT)
shinyUI(pageWithSidebar(
headerPanel("function1"),
sidebarPanel(
#Age input
numericInput(inputId = "n",
label = h4("Enter n:"),
value = ""),
numericInput(inputId = "mean1",
label = h4("Enter mean for Age:"),
value = ""),
numericInput(inputId = "sd1",
label = h4("Enter sd for Age:"),
value = ""),
#Cholestrol input
numericInput(inputId = "mean2",
label = h4("Enter mean for Cholestrol:"),
value = ""),
numericInput(inputId = "sd2",
label = h4("Enter sd for Cholestrol:"),
value = ""),
#Blood Pressure input
numericInput(inputId = "mean3",
label = h4("Enter mean for Blood Pressure:"),
value = ""),
numericInput(inputId = "sd3",
label = h4("Enter sd for Blood Pressure:"),
value = ""),
actionButton(inputId = "input_action", label = "Show Inputs")),
mainPanel(
h2("Input Elements"), # title with HTML helper
dataTableOutput("inputs"),
h2("Results"),
dataTableOutput("results")
)))
server.R
library(shiny)
library(DT)
rnorm2 <- function(n,mean,sd) { mean+sd*scale(rnorm(n)) }
shinyServer(function(input, output){
data <- eventReactive(input$input_action, {
matrix(
c(rnorm2(input$n, input$mean1, input$sd1),
rnorm2(input$n, input$mean2, input$sd2),
rnorm2(input$n, input$mean3, input$sd3)), byrow = FALSE,
ncol = 3)
})
inpts <- eventReactive(input$input_action, {
data.frame(Type = c("Age", "Cholestorol", "BP"),
N = c(input$n, input$n, input$n),
Mean = c(input$mean1, input$mean2, input$mean3),
SD = c(input$sd1, input$sd2, input$sd3))
})
output$inputs <- renderDataTable({
inpts()
})
output$results <- renderDataTable({
set <- as.data.frame(data())
colnames(set) <- c("Age", "BP", "Cholestorol")
set
})
})

Resources