在会话期间以 shiny 更新输入和输出的选择（值）

Question

我有一个闪亮的小例子，我想用它来说明我的问题。我想在会话期间更改我的数据集，这将更改我在应用程序中的选项。因此，在我闪亮的应用程序中，我获取了第二个 R 脚本（addrow），它改变了我现有的数据框。采购后，我想将我的输入年份更改为 2009 年并将输入条件更改为 volatil，以便我可以通过过滤这两个输入来绘制值。当我按下操作按钮“刷新数据框”时，我的数据框得到另一行，但我的输入选项没有改变，所以我无法显示现有的新值。我怎样才能让我的数据框和我的输入对现有的闪亮会话产生反应？采购新脚本会更改我的数据框 --> 我的输入 --> 我的输出

    library(shiny)
    library(dplyr)
    
    year <- c(2002, 2003, 2003, 2003, 2004, 2005, 2005)
    condition <- c("volatil", "volatil", "increase", "decrease", "volatil", "volatil", "increase")
    value <- c(3,5,10,1,6,22,25)
    
    example <- data.frame(year, condition, value)
    
    yearData <- example %>% group_by(year) %>% slice(1)
    condData <- example %>% select(year,condition) %>% distinct()
    
    path <- setwd("of second R Script (addrow) with only one row of code: example[8,] <- c(2009, "volatil", 55)")
    
    ui <- fluidPage(
      
      fluidRow(
        column(2,selectInput("year", h4("year:"),choices = yearData$year)),
        column(2,selectInput("cond", h4("condition:"), choices = condData$condition))
      ),
      
     
      hr(),
      actionButton("addrow","Refresh Dataframe"),
      actionButton("plot","Plot Data"),
      plotOutput("plotdata")
      
    )
    
   server <- function(input,output, session){
  
  
  observeEvent(input$addrow, {
    
    source(paste0(path,'/addrow.R'))
    
    showNotification("A Row was added")
    
  
  },priority = 1)
  
  
  condData2 <- eventReactive(input$addrow, {
    
    example %>% select(year,condition) %>% distinct()
    
  })
  
  
  observeEvent(c(input$year, input$addrow), {
    
    if(input$addrow){
      
      condData2 <- condData2()
      
      updateSelectInput(session, "cond",   choices = condData2$condition[condData2$year == input$year]) 
      
    } else {
      
      updateSelectInput(session, "cond",   choices = condData$condition[condData$year == input$year]) 
      
    }
  
    }, priority = 2 )
  
  
  
  observeEvent(input$plot, {
    
    print(input$year)
    print(input$cond)
    
    output$plotdata <- renderPlot({
      
       plot(example[example$year == input$year & example$condition == input$cond, ]$value, ylab= "value")
      
    })
    
  })
  
}

shinyApp(ui=ui, server=server)

Answer 1

您可以在 eventReactive 中添加一行。我已经添加了代码以在此代码中添加行。您可以来源添加行。试试这个

library(shiny)
library(dplyr)

year <- c(2002, 2003, 2003, 2003, 2004, 2005, 2005)
condition <- c("volatil", "volatil", "increase", "decrease", "volatil", "volatil", "increase")
value <- c(3,5,10,1,6,22,25)

example <- data.frame(year, condition, value)

yearData <- example %>% group_by(year) %>% slice(1)
condData <- example %>% select(year,condition) %>% distinct()

#path <- setwd("of second R Script (addrow) with only one row of code: example[8,] <- c(2009, "volatil", 55)")

ui <- fluidPage(
  
  fluidRow(
    column(2,selectInput("year", h4("year:"),choices = yearData$year)),
    column(2,selectInput("cond", h4("condition:"), choices = condData$condition))
  ),
  
  
  hr(),
  actionButton("addrow","Refresh Dataframe"),
  actionButton("plot","Plot Data"),
  # DTOutput("t1"), ## to check if add row is working
  plotOutput("plotdata")
  
)

server <- function(input,output, session){
  rv <- reactiveValues(data=example)
  
  example2 <- eventReactive(input$addrow, {
    val = 55 + as.numeric(input$addrow)
    
    #source(paste0(path,'/addrow.R'))
    newrow <- c(2009,"volatil",val)
    rv$data <- rbind(rv$data,newrow)
    
  })
  
  observeEvent(input$addrow, {
    req(example2())
    yearData2 <- example2() %>% group_by(year) %>% slice(1)
    condData2 <- example2() %>% select(year,condition) %>% distinct()
    
    updateSelectInput(session, "year",   choices = yearData2$year)
    updateSelectInput(session, "cond",   choices = condData2$condition)

    showNotification("A Row was added")
    
  },priority = 1)
  
  output$t1 <- renderDT({example2()})
  
  # condData2 <- eventReactive(input$addrow, {
  #   req(example2())
  #   example2() %>% select(year,condition) %>% distinct()
  #   
  # })
  # 
  # observeEvent(c(input$year, input$addrow), {
  #   
  #   if(input$addrow){
  #     
  #     condData2 <- condData2()
  #     
  #     updateSelectInput(session, "cond",   choices = condData2$condition[condData2$year == input$year]) 
  #     
  #   } else {
  #     
  #     updateSelectInput(session, "cond",   choices = condData$condition[condData$year == input$year]) 
  #     
  #   }
  #   
  # }, priority = 2 )
  
  
  observeEvent(input$plot, {
    if (input$addrow) {exampl <- example2()
    }else exampl <- example
    print(input$year)
    print(input$cond)
    
    output$plotdata <- renderPlot({
      
      ggplot(exampl, aes(x=year, y=value, color=condition)) + geom_point()
      #plot(exampl[exampl$year == input$year & exampl$condition == input$cond, ]$value, ylab= "value")
      
    })
    
  })
  
}

shinyApp(ui=ui, server=server)

在会话期间以 shiny 更新输入和输出的选择（值）

update choices (values) of input and output in shiny during a session

session

r

updates

shiny

reactive