【问题标题】:only refresh shiny plot at launch and if action button is clicked仅在启动时刷新闪亮的绘图并且如果单击操作按钮
【发布时间】:2020-05-09 18:57:48
【问题描述】:

我想在启动时渲染闪亮的图,然后需要单击操作按钮重新渲染。我试图简化我的应用程序以在此处发布。如您所见,更改“周”选择会触发刷新。除非单击操作,否则如何禁止所有刷新?

library(shiny); library(dplyr); library(ggplot2)

#toy data
dates= seq.Date(as.Date("2020-01-01"),as.Date("2020-05-01"),by="days")
set.seed(1)
data = data.frame(date = dates,val = runif(length(dates),50,150))

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("group","Group",choices = LETTERS[1:3]),
      dateRangeInput('dateRangeCal', "Input date range"),
      selectInput("week","shift week",choices = c(0:3)),
      actionButton("action","Submit")
    ),
    mainPanel(
      plotOutput(outputId = "plot")
    )
  )
)

server <- function(input, output,session) {

  observeEvent( input$action, {
    startDate = as.Date("2020-01-01")+days(case_when(
      input$group == "A" ~ 0,
      input$group == "B" ~ 30,
      input$group == "C" ~ 60
    ))
    endDate=startDate+days(60)
    updateDateRangeInput(session = session, 
                         inputId = 'dateRangeCal',
                         label = 'Date range input:',
                         start = startDate,
                         end = endDate
    )

  },ignoreNULL = F)

  output$plot <- renderPlot({
    p = data %>%
      filter(date>=input$dateRangeCal[1]+days(input$week)*7,date<=input$dateRangeCal[2]) %>%
      ggplot(.,aes(x=date,y=val))+
      geom_line()
    p
  })
}

shinyApp(ui, server)

【问题讨论】:

  • isolate(input$week) in renderPlot 应该这样做。
  • 我试过了。这消除了 input$week 的依赖。我需要情节依赖于它,只需保持刷新直到点击操作。

标签: r shiny


【解决方案1】:

应该这样做:

server <- function(input, output,session) {

  week <- reactiveVal()

  observeEvent( input$action, {
    week(input$week)
    startDate = as.Date("2020-01-01")+days(case_when(
      input$group == "A" ~ 0,
      input$group == "B" ~ 30,
      input$group == "C" ~ 60
    ))
    endDate=startDate+days(60)
    updateDateRangeInput(session = session, 
                         inputId = 'dateRangeCal',
                         label = 'Date range input:',
                         start = startDate,
                         end = endDate
    )

  },ignoreNULL = F)

  output$plot <- renderPlot({
    p = data %>%
      filter(date>=input$dateRangeCal[1]+days(week())*7,date<=input$dateRangeCal[2]) %>%
      ggplot(.,aes(x=date,y=val))+
      geom_line()
    p
  })
}

【讨论】:

  • 这似乎有效。如果在我的实际应用程序中,我有多个额外的输入选择,我假设我需要在服务器中使用 ReactiveVal() 调用所有这些输入,并在 observeEvent 中调用所有这些输入?
  • 这只适用于第一次。单击操作按钮后,控件进入 observeEvent() 内部,然后不单击操作按钮,输出图不断变化。这是不可取的。
  • @LazarusThurston observeEvent 仅在单击按钮时做出反应。这就是事件观察者的目的。
【解决方案2】:

这行得通吗?

library(shiny); library(dplyr); library(ggplot2); library(lubridate)

#toy data
dates= seq.Date(as.Date("2020-01-01"),as.Date("2020-05-01"),by="days")
set.seed(1)
data = data.frame(date = dates,val = runif(length(dates),50,150))

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            selectInput("group","Group",choices = LETTERS[1:3]),
            dateRangeInput('dateRangeCal', "Input date range"),
            selectInput("week","shift week",choices = c(0:3)),
            actionButton("action","Submit")
        ),
        mainPanel(
            plotOutput(outputId = "plot")
        )
    )
)

server <- function(input, output,session) {

    observeEvent(input$action, {
        grp <- isolate(input$group)
        startDate = as.Date("2020-01-01")+days(case_when(
            grp == "A" ~ 0,
            grp == "B" ~ 30,
            grp == "C" ~ 60
        ))
        endDate=startDate+days(60)
        updateDateRangeInput(session = session, 
                             inputId = 'dateRangeCal',
                             label = 'Date range input:',
                             start = startDate,
                             end = endDate
        )

    },ignoreNULL = F)

    output$plot <- renderPlot({
        input$action
        rangecal <- isolate(input$dateRangeCal)
        p = data %>%
            filter(date>=rangecal[1]+days(isolate(input$week))*7,date<=rangecal[2]) %>%
            ggplot(.,aes(x=date,y=val))+
            geom_line()
        p
    })
}

shinyApp(ui, server)

【讨论】:

    猜你喜欢
    • 2018-10-09
    • 2021-07-16
    • 2022-01-26
    • 2016-02-09
    • 1970-01-01
    • 2019-01-10
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多