I am trying to change the values from a sliderInput dynamically. The difficulty now is that I want to change from a sliderInput with one value, to a sliderInput with a range, which seems not to work.
The first actionbutton in the code below works, while the second does not what it is intended to do.
Is the only possibility to switch to an uiOutput element?
Code
library(shiny)
app <- shinyApp(
ui = bootstrapPage(
sliderInput("sld1", min = 0, max = 10, label = "y1", value = 5),
actionButton("acb1", "Change Value"),
actionButton("acb2", "Change Value to Range")
),
server = function(input, output, session) {
observeEvent(input$acb1, {
updateSliderInput(session, "sld1", value = 2)
})
observeEvent(input$acb2, {
updateSliderInput(session, "sld1", value = c(2,7))
})
})
runApp(app)
You can maybe add the slider dynamically using renderUI
#rm(list = ls())
library(shiny)
app <- shinyApp(
ui = bootstrapPage(
uiOutput("myList"),
actionButton("acb1", "Change Value"),
actionButton("acb2", "Change Value to Range")
),
server = function(input, output, session) {
slidertype <- reactiveValues()
slidertype$type <- "default"
observeEvent(input$acb1,{slidertype$type <- "normal"})
observeEvent(input$acb2, {slidertype$type <- "range"})
output$myList <- renderUI({
if(slidertype$type == "normal"){
sliderInput("sld1", min = 0, max = 10, label = "y1", value = 2)
}
else if(slidertype$type == "range"){
sliderInput("sld1", min = 0, max = 10, label = "y1", value = c(2,7))
}
else{
sliderInput("sld1", min = 0, max = 10, label = "y1", value = 5)
}
})
})
runApp(app)
Related
I'm looking at having two sliders that should update together, based on some function. For example, one slider is the square root of the other. I want to be able to change either slider and for the other one to update reactively.
The following does work:
library(shiny)
server = function(input, output) {
f = reactive(function(x) x^2)
finv =reactive(function(x) sqrt(x))
output$x <- renderUI({
slider_s.value <- input$s
default.slider_x <- if (is.null(slider_s.value)) 1 else f()(slider_s.value)
sliderInput("x", "Select x:",
min = 0, max=100,
value = default.slider_x, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
output$s <- renderUI({
slider_x.value <- input$x
default.slider_s <- if (is.null(slider_x.value)) finv()(1) else finv()(slider_x.value)
sliderInput("s", "Select s:",
min = 0, max=10,
value = default.slider_s, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
}
ui = fluidPage(
titlePanel("One Way Reactive Slider"),
fluidRow(
column(3,
wellPanel(
h4("Slider Inputs"),
uiOutput('s'),
uiOutput('x')
))
)
)
shinyApp(ui = ui, server = server)
However, this doesn't.
library(shiny)
server = function(input, output) {
g = reactive(function(x) x^2 - input$slider)
ginv =reactive(function(x) sqrt(x+ input$slider))
output$slider <- renderUI({
sliderInput("slider", "Slider input:",
min = 1, max = 100, value = 2)
})
output$x <- renderUI({
slider_s.value <- input$s
default.slider_x <- if (is.null(slider_s.value)) 1 else g()(slider_s.value)
sliderInput("x", "Select x:",
min = 0, max=100,
value = default.slider_x, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
output$s <- renderUI({
slider_x.value <- input$x
default.slider_s <- if (is.null(slider_x.value)) ginv()(1) else ginv()(slider_x.value)
sliderInput("s", "Select s:",
min = 0, max=10,
value = default.slider_s, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
}
ui = fluidPage(
titlePanel("One Way Reactive Slider"),
fluidRow(
column(3,
wellPanel(
h4("Slider Inputs"),
uiOutput('slider'),
uiOutput('s'),
uiOutput('x')
))
)
)
shinyApp(ui = ui, server = server)
It messes up when the "Slider Input" is changed. Is there some way that I can get round this? I've seen other posts on here about constraining sliders but none seem to rely on other inputs like this.
Note that I want x = g(s) and s = ginv(x) which should be okay since g and ginv are inverses of each other!
Some changes are required in output$x <- RenderUI code block to fix the slider values flickering issue.
output$x <- renderUI({
slider_slider.value <- input$slider
default.slider_x <- if (is.null(slider_slider.value)) 1 else g()(slider_slider.value)
sliderInput("x", "Select x:",
min = 0, max=100,
value = default.slider_x, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
I have an app with two numericinput. Both presented values between 0 and 1. What I wanted to do is the following: As the sum of the two weights must equal 1, so when I select the first weight, for example, 0.2, the second will be 0.8. Got the idea?
Executable code below
library(shiny)
ui <- fluidPage(
numericInput("weight1", label = h4("Weight 1"),
min = 0, max = 1, value = 0.5),
numericInput("weight2", label = h4("Weight 2"),
min = 0, max = 1, value = 0.5),
helpText("The sum of weights should be equal to 1"),
hr(),
fluidRow(column(3, verbatimTextOutput("value1"))),
fluidRow(column(3, verbatimTextOutput("value2")))
)
server <- function(input, output,session) {
output$value1 <- renderPrint({ input$weight1 })
output$value2 <- renderPrint({ input$weight2 })
}
shinyApp(ui = ui, server = server)
You can do it by using observeEvent and updateNumericInput.
Here's what the code will look like:
server <- function(input, output,session) {
observeEvent(input$weight1, {
updateNumericInput(session, 'weight2',
value = 1 - input$weight1)
})
output$value1 <- renderPrint({ input$weight1 })
output$value2 <- renderPrint({ input$weight2 })
}
Note: You don't need updateNumericInput if you are dealing with only two numbers and every time you need the sum to be equal to 1.
I would like to fix the range in a shiny sliderInput such that it may only be dragged left or right, keeping the same range always. In the example below, the range is always kept to 10 but any range of 10 may be selected, e.g. 71-81 etc. Is it possible?
library(shiny)
ui <- fluidPage(
sliderInput(
inputId = "foo",
label = "Select Range",
min = 0,
max = 100,
value = c(50, 60),
step = 1,
dragRange = T
))
shinyApp(ui = ui, server = function(input, output) {})
Perhaps you are looking for this
library(shiny)
ui <- fluidPage(
sliderInput(
inputId = "foo",
label = "Select Range",
min = 0,
max = 100,
value = c(50, 60),
step = 1,
dragRange = T
))
server = function(input, output,session) {
observeEvent(input$foo[1], {
if (input$foo[1]<=90) mnval <- input$foo[1]
else mnval = 90
mxval = input$foo[1] + 10
updateSliderInput(session, "foo", min =0,max=100, value = c(mnval,mxval))
})
}
shinyApp(ui = ui, server = server)
I am trying to get the app to display a number of slider/numeric input pairs equal to the initial numeric input. I want each slider and numeric input pair to be coordinated with each other such they always display the same value, like in the example I have below. Any help is appreciated. Thank you.
library(shiny)
ui <- fluidPage(
titlePanel("Test"),
sidebarLayout(
sidebarPanel(
numericInput(inputId = "times", label = "Number of sliders", value = 1, min = 1, max = 100),
sliderInput(inputId = "Slider1", "Slider1", min = 1, max = 100, value = 50),
textInput(inputId = "Text1", "Text1", value = 50)
),
mainPanel(uiOutput("plots"))
)
)
server <- shinyServer(function(input, output, session) {
list_num <- reactiveValues(value=NULL)
list_index <- reactiveValues(value=NULL)
observeEvent(list_num$value, { updateSliderInput(session, "Slider1", max=list_num$value)
})
observeEvent(input$Slider1, { print(paste0("Slider1 initial value ", input$Slider1))
list_index$value <- input$Slider1
})
observeEvent(input$Text1, { print(paste0("Text1 initial value ", input$Text1))
list_index$value <- max(1, as.numeric(input$Text1))
})
observeEvent (list_index$value, {
if (is.na(input$Slider1) | is.na(list_index$value) | list_index$value != input$Slider1) { updateSliderInput(session, "Slider1", value=list_index$value) }
else {updateTextInput(session, "Text1", value=list_index$value)}
})
})
shinyApp(ui, server)
I try to print in log an input which has been updated by a user in an app. Something very close can be done with observeEvent.
observeEvent(c(input$integer, input$decimal, input$range), {
flog.info(glue::glue('The user updated a value!'))
})
But I want to see in log the name of updated object without its containing values. How is it possible to do?
if (interactive()) {
library(shiny)
library(futile.logger)
library(glue)
ui <- fluidPage(
titlePanel("Sliders"),
sidebarLayout(
sidebarPanel(
sliderInput("integer", "Integer:",
min = 0, max = 1000,
value = 500),
sliderInput("decimal", "Decimal:",
min = 0, max = 1,
value = 0.5, step = 0.1),
sliderInput("range", "Range:",
min = 1, max = 1000,
value = c(200,500))
),
mainPanel(
tableOutput("values")
)
)
)
# Define server logic for slider examples ----
server <- function(input, output) {
observeEvent(c(input$integer, input$decimal, input$range), {
flog.info(glue::glue('The user updated a value!'))
})
# Reactive expression to create data frame of all input values ----
sliderValues <- reactive({
data.frame(
Name = c("Integer",
"Decimal",
"Range"),
Value = as.character(c(input$integer,
input$decimal,
paste(input$range, collapse = " "))),
stringsAsFactors = FALSE)
})
# Show the values in an HTML table ----
output$values <- renderTable({
sliderValues()
})
}
# Create Shiny app ----
shinyApp(ui, server)
}
A solution with the help of the shiny:inputchanged event:
library(shiny)
js <- "
$(document).on('shiny:inputchanged', function(e) {
if(e.name != 'updated' && e.name != '.clientdata_output_values_hidden'){
Shiny.setInputValue('updated', e.name, {priority: 'event'});
}
});"
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
titlePanel("Sliders"),
sidebarLayout(
sidebarPanel(
sliderInput("integer", "Integer:",
min = 0, max = 1000, value = 500),
sliderInput("decimal", "Decimal:",
min = 0, max = 1, value = 0.5, step = 0.1),
sliderInput("range", "Range:",
min = 1, max = 1000, value = c(200,500))
),
mainPanel(
tableOutput("values")
)
)
)
server <- function(input, output) {
observeEvent(input$updated, {
# do something with the name of the updated input,
# e.g flog.info(glue::glue(input$updated))
print(input$updated)
})
sliderValues <- reactive({
data.frame(
Name = c("Integer",
"Decimal",
"Range"),
Value = as.character(c(input$integer,
input$decimal,
paste(input$range, collapse = " "))),
stringsAsFactors = FALSE)
})
output$values <- renderTable({
sliderValues()
})
}
shinyApp(ui, server)