I have a Shiny app with a slider input and I would like to set the maximum possible value for the slider based on a maximum value in the dataset uploaded by the user. The max distance will change based on the dataset uploaded.
Here is a minimum working example of what I am trying to do. Below I just hardcode the number for the maxdistance, but in my code it is calculated:
library(shiny)
ui <- fluidPage(
sliderInput("range_one", "Core:", min = 0, max = textOutput("maxdistance"), value = c(0,0))
)
server <- function(input,output) {
output$maxdistance <- renderText({
maxdistance <- 250
return(maxdistance)
})
}
shinyApp(ui=ui,server=server)
I get the following error:
Error in max - min : non-numeric argument to binary operator
Which makes sense because I as asking for a text output, so how do I get this output as a numeric value for use in the sliderInput() function?
Here is an example.
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("change", "Change slider max value")
),
mainPanel(
plotOutput("distPlot")
)
)
))
server <- shinyServer(function(input, output, session) {
observeEvent(input$change, {
max = sample(50:100, 1)
updateSliderInput(session, "bins", max=max)
})
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
})
shinyApp(ui = ui, server = server)
Change as follows, it will work:
sliderInput("range_one", "Core:",
min = 0, max = as.integer(textOutput("maxdistance")),
value = c(0,0))
Here is the code I am using on the server side to achieve the desired result of my original question, without the need for an action button:
observe({
infile <- input$file # user input file upload
if(!is.null(infile)) {
processed <- processed() # list of processed elements returned from earlier reactive({}) function with my app
processed_data <- processed$processed_data # get the processed data from the list and save as data frame
maxdistance <- max(processed_data$distance) # calculate the max distance from the processed data
updateSliderInput(session, "range_one", max=maxdistance) # update the slider called "range_one" based on the maxdistance
}
})
This allows the app to use the default maximum slider value until a file is uploaded. Once the user uploads a file, the data is processed and the slider is updated.
Related
My app should follow this logic: If an action button is pressed, all inputs are disabled and a long computation is performed. When the computation is finished and its results are plotted, all inputs except for the action button become enabled again. If the user decides to change one input, the action button becomes enabled.
Most of this desired behaviour is working, except for the last bit, the enabling of the action button. Here is my server function (the action button is named "go"):
server <- function(input, output, session) {
allinputIds <- reactive(names(input))
shiny::observeEvent(input$go, {
for (id in allinputIds()) shinyjs::disable(id)
})
# ==> here is some trouble: not working
shiny::observeEvent(allinputIds(), shinyjs::enable("go"))
# from here starts the real work
bins <- shiny::eventReactive(input$go, {
x <- faithful$waiting
Sys.sleep(1.5)
seq(min(x), max(x), length.out = input$bins + 1)
})
output$figure <- shiny::renderPlot({
x <- faithful$waiting
hist(
x, breaks = bins(), col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
for (id in setdiff(allinputIds(), "go")) shinyjs::enable(id)
})
}
How can I observe that any input has been changed? Instead of allinputIds() after the line marked "==>", I tried input but this worked neither.
As a second question, what would you recommend to encapsulate this button / disable / enable pattern, which I plan to use on more than one shiny module. It would be nice if I could concentrate on the main code, i.e. bins and output$figure <- ....
Any hint appreciated!
For reproducibility, here is the ui function:
ui <- shiny::tagList(
shinyjs::useShinyjs(),
shiny::navbarPage(title="Test 2",
tabPanel(title="Old Faithful",
shiny::sidebarLayout(
shiny::sidebarPanel(
shiny::sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30
)
),
shiny::mainPanel(
shiny::actionButton("go", "Update"),
shinycssloaders::withSpinner(plotOutput(outputId="figure")),
shiny::h4(shiny::textOutput("msg"))
)
)
)
)
)
shiny::shinyApp(ui, server)
The problem is that in shiny::observeEvent(allinputIds(), shinyjs::enable("go")) you just check if the names/amount of input ids change - they don't. You actually need to check if the values of any of the inputs (besides the action button) has changed. Therefore you can either put all inputs directly into the observe like c(input$bins, input$...) or make an extra reactive to check for the values and just call this reactive.
library(shiny)
server <- function(input, output, session) {
allinputIds <- reactive(names(input))
changingInputValues <- reactive({
checkIds <- setdiff(names(input), "go")
lapply(checkIds, function(x) input[[x]])
})
observeEvent(input$go, {
lapply(allinputIds(), shinyjs::disable)
})
# ==> here is some trouble: not working
observeEvent(changingInputValues(), shinyjs::enable("go"))
# from here starts the real work
bins <- eventReactive(input$go, {
x <- faithful$waiting
Sys.sleep(1.5)
seq(min(x), max(x), length.out = input$bins + 1)
})
output$figure <- renderPlot({
x <- faithful$waiting
hist(
x, breaks = bins(), col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
lapply(setdiff(allinputIds(), "go"), shinyjs::enable)
})
}
ui <- tagList(
shinyjs::useShinyjs(),
navbarPage(title="Test 2",
tabPanel(title="Old Faithful",
sidebarLayout(
sidebarPanel(
sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30
)
),
mainPanel(
actionButton("go", "Update"),
shinycssloaders::withSpinner(plotOutput(outputId="figure")),
h4(textOutput("msg"))
)
)
)
)
)
shinyApp(ui, server)
Note that I've changed the for loops to lapply, as for loops tend to not work well with shiny (unfortunately, I'm not sure why). A few times the enabling of the inputs didn't work when using the loop, but with lapply I haven't had any problems.
I want to create a small shiny app to explore a scoring function that I am writing for a set of data observations. This is my first shiny app so bear with me.
What I want to show is the data table where one column is computed by a function (let's say f(x) = x^2 + y) where x is another (numeric) column in the table and y should be adjustable with a slider in the sidebar.
I want to make the table reactive, so that as soon as the slider is adjusted, the content that is displayed will be updated. Does anyone have a link to a tutorial (I could not find a similar problem) or a suggestion how to handle this. If so, please let me know!
This is the code I have so far:
library(shiny)
#### INIT ####
x <- 1
y <- 0.5
z <- 2
df <- data.frame(
a=1:10,
b=10:1
)
df['score'] <- df[,x]^y + z
#### UI ####
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
sliderInput("x", "x:",
min = 0, max = ncol(df),
value = 1),
sliderInput("y", "y:",
min = 1, max = 10,
value = 1),
sliderInput("z", "z:",
min = 1, max = 100,
value = 20)
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("df", dataTableOutput("df"))
)
)
)
)
#### SERVER ####
server <- function(input, output) {
sliderValues <- reactive({
df['score'] <- df[,input$x]^input$y + input$z
})
sliderValues()
output$df<- renderDataTable(df)
}
#### RUN ####
shinyApp(ui = ui, server = server)
Just make the data.frame you actually plot reactive. For example
server <- function(input, output) {
calcualtedValues <- reactive({
df['score'] <- df[,input$x]^input$y + input$z
df
})
output$df<- renderDataTable(calcualtedValues())
}
Here the calcualtedValues reactive element returns a new data.frame when the input is updated, and then you actually render that updated data.frame rather than the original data.frame each time.
Is it possible for multiple users of the same app to make changes to the same set of reactive values?
This question (handling multiple users simulaneously in an R Shiny app) suggests that multiple users in different sessions can make changes to the same value (by declaring it outside of server() and using <<- instead of <- ) But that is for just plain old values/variables. Is this possible for reactive values?
Ideally, I would like a change made by user A to be immediately reflected in some output viewed by user B.
Here's a minimal working example based on RStudio's default one-file Shiny app:
library(shiny)
slidervalue <- 30
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = slidervalue)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot"),
textOutput('txt')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
observe({
slidervalue <<- input$bins
})
reactive_slidervalue <- reactivePoll(100, session,
checkFunc = function() { slidervalue },
valueFunc = function() { slidervalue }
)
output$txt <- renderText(reactive_slidervalue())
observe({
updateSliderInput(session, 'bins', value = reactive_slidervalue())
})
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = reactive_slidervalue() + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
Basically, I am using a global variable (as you and and the post suggested), and then hooked it back into server by using the reactivePoll function to make the external dependency reactive.
Im creating shiny app. for calculating risk score where the user will upload input file and select the input such as ethnic groups, type of calculating score and diseases. After all of the input are selected and file is uploaded, my App. will be run when user click at action button and the output such as graph and dataframe will be shown
Im using observeEvent to control my App for triggering unnecessarily( mulitple handleExpr with one eventExpr), and this is my shorten version of code. Im sorry for my code that is not reproducible.
observeEvent(input$action,{
isolate(system2("bash_script/plink.sh",args = c(input$file$datapath,input$type,input$sum_stat,input$Disease,input$Ethnic,input$Ref)))
output$table_score <- renderDataTable({
percentile <- read.csv("../output/score_percentile.csv",header = T, sep = "\t")
}, selection = "single")
output$table_variant <- renderDataTable({
varaints_in_sample <- fread("../output/summary.csv", header = T, drop = 1)
})
#Plot Graph
output$plot <- renderPlot({
s <- input$table_score_cell_clicked
plot("../output/score_percentile_plot.csv",s,"analysis")
})
})
my problem is that when Im running app for the first time, everything is controllable. However, if I want to select new input. for example im changing input disease from heart disease to another disease. my App. will be triggered unnecessarily although I did NOT click at action button.
So, Is there any way to use observeEvent with one evenExpr for mulitple handleExpr
Thanks everyone for your help!
I think, this is simplified example of your problem. The solution is to put all your input$... inside isolate().
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton('action', 'Click')
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
req(input$action)
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = isolate(input$bins) + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui = ui, server = server)
I have a slider input type of 'range' in my Shiny app and I would like to get the minimum and maximum values selected by the user in my server.R
in my ui.R I have
sliderInput("range", "Age:",
min = 0, max = 100, value = c(0,100))
and I would like to get the selected values not min and max that I have defined
You can access the slider ranges using input$range[1] for min and input$range[2] for max
library(shiny)
ui <- basicPage(sliderInput("range", "Age:",min = 0, max = 100, value = c(0,100)),textOutput("SliderText"))
server <- shinyServer(function(input, output, session){
my_range <- reactive({
cbind(input$range[1],input$range[2])
})
output$SliderText <- renderText({my_range()})
})
shinyApp(ui = ui, server = server)