[英]Avoid DRY with 13 sliderInputs and 13 textInputs
I have this simple app: Here with the slider input we choose a number and put it into text input and vice versa.我有这个简单的应用程序:这里输入 slider,我们选择一个数字并将其放入文本输入,反之亦然。 The output is given also in a dataframe.
output 也在 dataframe 中给出。
I would like to do this not only for 3 letters like here (A, B, C).我想不仅对这里的 3 个字母(A、B、C)执行此操作。 I would like to automate the creation of such sliders and textput 13 times eg (A, B, C..., K,L,M).
我想自动创建此类滑块和文本输入 13 次,例如(A、B、C...、K、L、M)。 Where A to K is in a vector to select.
其中 A 到 K 在指向 select 的向量中。
I could add 10 more times the code but I want to automate the process:我可以再添加 10 倍的代码,但我想自动化该过程:
How could I avoid to repeat the as #REPEATED
and as #ForA, #ForB, #ForC
marked code:我怎样才能避免重复 as
#REPEATED
和 as #ForA, #ForB, #ForC
标记的代码:
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)
You can return list
s of html objects and reactive components:可以返回 html 个对象和反应组件的
list
:
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.) (我第二次使用
Map
只是为了保持一致性, lapply
也同样有效。)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.