[英]How to trigger observeEvent and action with different input types in R Shiny?
我拥有的
我制作了一个 Shiny 应用程序,它显示了一些点的情节。
您可以手动更改 y 轴。 有一个按钮可以自动调整 y 轴,使其适合数据。 有一个下拉框可让您选择数据。
我有这个代码:
library(shiny)
# user interface ----------------------------------------------------------
ui <- fluidPage(
fluidRow(plotOutput("myplot")),
tabsetPanel(
tabPanel(
"Input",
fluidRow(
column(
2,
numericInput(inputId = "ymax", label = "y-axis maximum", value = 30),
numericInput(inputId = "ymin", label = "y-axis minimum", value = 9),
actionButton("fity", label = "zoom to fit")
),
column(
2,
selectInput(inputId = "yaxis", label = "y-axis",
choices = list("1 to 5" = 1,
"3 to 7" = 2)
),
checkboxInput("mybx", label = "checkbox", value = TRUE)
)
)
),
fluidRow()
)
)
# server function ---------------------------------------------------------
server <- function(input, output, session) {
ydata <- reactive({
switch(input$yaxis,
"1" = {
updateCheckboxInput(session, "mybx", value = TRUE)
1:5},
"2" = {
updateCheckboxInput(session, "mybx", value = FALSE)
3:7}
)
})
observeEvent(input$fity, {
newymax <- trunc(max(ydata())) + 1
newymin <- trunc(min(ydata()))
updateNumericInput(session, "ymax", value = newymax)
updateNumericInput(session, "ymin", value = newymin)}
)
output$myplot <- renderPlot({
par(mar = c(4, 4, 0.1, 0.1))
plot(x = 1:5, y = ydata(), ylim = c(input$ymin, input$ymax))
})
}
shinyApp(ui = ui, server = server)
我想做的事
我希望当我使用下拉框更改数据时,也将触发由操作按钮触发的适合 y 轴代码。
我尝试过的事情:
selectInput
与按钮一起使用。ydata <- reactive
observeEvent
和observeEvent
调用该函数。 不工作。 关于递归的呐喊(显然 - 它再次从 ydata 内部调用 ydata!)。任何帮助,将不胜感激。
为什么不只是有另一个observeEvent
监控的变化yaxis
输入?
library(shiny)
# user interface ----------------------------------------------------------
ui <- fluidPage(
fluidRow(plotOutput("myplot")),
tabsetPanel(
tabPanel(
"Input",
fluidRow(
column(
2,
numericInput(inputId = "ymax", label = "y-axis maximum", value = 30),
numericInput(inputId = "ymin", label = "y-axis minimum", value = 9),
actionButton("fity", label = "zoom to fit")
),
column(
2,
selectInput(inputId = "yaxis", label = "y-axis",
choices = list("1 to 5" = 1,
"3 to 7" = 2)
),
checkboxInput("mybx", label = "checkbox", value = TRUE)
)
)
),
fluidRow()
)
)
server <- function(input, output, session) {
ydata <- reactive({
switch(input$yaxis,
"1" = {
updateCheckboxInput(session, "mybx", value = TRUE)
1:5},
"2" = {
updateCheckboxInput(session, "mybx", value = FALSE)
3:7}
)
})
observeEvent(input$fity, {
newymax <- trunc(max(ydata())) + 1
newymin <- trunc(min(ydata()))
updateNumericInput(session, "ymax", value = newymax)
updateNumericInput(session, "ymin", value = newymin)}
)
observeEvent(input$yaxis, {
newymax <- trunc(max(ydata())) + 1
newymin <- trunc(min(ydata()))
updateNumericInput(session, "ymax", value = newymax)
updateNumericInput(session, "ymin", value = newymin)}
)
output$myplot <- renderPlot({
par(mar = c(4, 4, 0.1, 0.1))
plot(x = 1:5, y = ydata(), ylim = c(input$ymin, input$ymax))
})
}
shinyApp(ui = ui, server = server)
但这会使您的“缩放以适合”按钮变得多余。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.