I have this simple app: Here with the slider input we choose a number and put it into text input and vice versa. The output is given also in a dataframe.
I would like to do this not only for 3 letters like here (A, B, C). I would like to automate the creation of such sliders and textput 13 times e.g. (A, B, C ..., K,L,M). Where A to K is in a vector to select.
I could add 10 more times the code but I want to automate the process:
How could I avoid to repeat the as #REPEATED and as #ForA, #ForB, #ForC marked code:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
sidebarLayout(
# Sidebar to demonstrate various slider options ----
sidebarPanel(width = 4,
setSliderColor(c("DeepPink ", "#FF4500", "Teal"), c(1, 2, 3)),
# Input: Simple integer interval ----
div(class = "label-left",
#REPEATED----------------------------------------------------
div(style="display: inline-block;vertical-align:middle; width: 300px;",sliderInput("a", "A", min = 0, max = 3, value = 0, width = "250px")),
div(style="display: inline-block;vertical-align:middle; width: 150px;",textInput("txt_a", label = NULL, value = 0, width = "40px" )),
div(style="display: inline-block;vertical-align:middle; width: 300px;",sliderInput("b", "B", min = 0, max = 3,value = 0, width = "250px")),
div(style="display: inline-block;vertical-align:middle; width: 150px;",textInput("txt_b", label = NULL, value = 0, width = "40px" )),
div(style="display: inline-block;vertical-align:middle; width: 300px;",sliderInput("c", "C", min = 0, max = 3,value = 0, width = "250px")),
div(style="display: inline-block;vertical-align:middle; width: 150px;",textInput("txt_c", label = NULL, value = 0, width = "40px" )),
#REPEATED------------------------------------------------------------------------------------------------------------------------
)
),
# Main panel for displaying outputs ----
mainPanel(
titlePanel("Sliders"),
# Output: Table summarizing the values entered ----
tableOutput("values")
)
)
)
server <- function(input, output, session) {
# For A----------------------------------------------------------------------
observeEvent(input$txt_a,{
if(as.numeric(input$txt_a) != input$a)
{
updateSliderInput(
session = session,
inputId = 'a',
value = input$txt_a
) # updateSliderInput
}#if
})
observeEvent(input$a,{
if(as.numeric(input$txt_a) != input$a)
{
updateTextInput(
session = session,
inputId = 'txt_a',
value = input$a
) # updateTextInput
}#if
})
# For B----------------------------------------------------------------------
observeEvent(input$txt_b,{
if(as.numeric(input$txt_b) != input$b)
{
updateSliderInput(
session = session,
inputId = 'b',
value = input$txt_b
) # updateSliderInput
}#if
})
observeEvent(input$b,{
if(as.numeric(input$txt_b) != input$b)
{
updateTextInput(
session = session,
inputId = 'txt_b',
value = input$b
) # updateTextInput
}#if
})
#For C----------------------------------------------------------------------
# For A
observeEvent(input$txt_c,{
if(as.numeric(input$txt_c) != input$c)
{
updateSliderInput(
session = session,
inputId = 'c',
value = input$txt_c
) # updateSliderInput
}#if
})
observeEvent(input$c,{
if(as.numeric(input$txt_c) != input$c)
{
updateTextInput(
session = session,
inputId = 'txt_c',
value = input$c
) # updateTextInput
}#if
})
# Reactive expression to create data frame of all input values ----
sliderValues <- reactive({
data.frame(
Name = c("A",
"B",
"C"),
Value = as.character(c(input$a,
input$b,
input$c
)),
stringsAsFactors = FALSE)
})
# Show the values in an HTML table ----
output$values <- renderTable({
sliderValues()
})
}
shinyApp(ui, server)
CodePudding user response：
You can return lists of html objects and reactive components:
ui <- fluidPage(
sidebarLayout(
# Sidebar to demonstrate various slider options ----
sidebarPanel(width = 4,
setSliderColor(c("DeepPink ", "#FF4500", "Teal"), c(1, 2, 3)),
# Input: Simple integer interval ----
div(class = "label-left",
Map(function(id, lbl) {
list(
div(style="display: inline-block;vertical-align:middle; width: 300px;",sliderInput(id, lbl, min = 0, max = 3, value = 0, width = "250px")),
div(style="display: inline-block;vertical-align:middle; width: 150px;",textInput(paste0("txt_", id), label = NULL, value = 0, width = "40px" ))
)
}, c("a", "b", "c"), c("A", "B", "C"))
)
),
# Main panel for displaying outputs ----
mainPanel(
titlePanel("Sliders"),
# Output: Table summarizing the values entered ----
tableOutput("values")
)
)
)
server <- function(input, output, session) {
Map(function(id) {
list(
observeEvent(input[[paste0("txt_", id)]], {
if(as.numeric(input[[paste0("txt_", id)]]) != input[[id]])
{
updateSliderInput(
session = session,
inputId = id,
value = input[[paste0("txt_", id)]]
) # updateSliderInput
}#if
}),
observeEvent(input[[id]], {
if(as.numeric(input[[paste0("txt_", id)]]) != input[[id]])
{
updateTextInput(
session = session,
inputId = paste0("txt_", id),
value = input[[id]]
) # updateTextInput
}#if
})
)
}, c("a", "b", "c"))
# Reactive expression to create data frame of all input values ----
sliderValues <- reactive({
data.frame(
Name = c("A",
"B",
"C"),
Value = as.character(c(input$a,
input$b,
input$c
)),
stringsAsFactors = FALSE)
})
# Show the values in an HTML table ----
output$values <- renderTable({
sliderValues()
})
}
(I used Map the second time only for consistency, lapply works equally well.)