0

I have a small shiny example with which I would like to illustrate my problem. I want to change my dataset during a session which will change my options in my app. So during my shiny app I source a second R Script (addrow) which change my existing dataframe. After sourcing I would like to change my input- year to 2009 and input - condition to volatil so that i can plot the value by filtering on this two inputs. When I push the actionbutton "refresh dataframe" my dataframe gets another row but my input options doesnt change so that i can not display the existing new value. How can I make my dataframe and my inputs reactive to an existing shiny session? Sourcing a new Script changes my dataframe --> my inputs --> my outputs

    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)
Ronak Shah
  • 377,200
  • 20
  • 156
  • 213
jimbo
  • 13
  • 3
  • Please verify that your updated data (with added rows) is available outside the `observeEvent(input$addrow, {...})`. My guess is it is not. One way to do is to create a `reactiveValues` object of the updated data frame in that `observeEvent`. Then use it in creating `condData2 <- eventReactive(input$addrow, {...})`. – YBS Mar 07 '21 at 13:03
  • If I add data <- reactiveValues(df_data = NULL) infront of the observeEvent(input$addrow, {...}) and data$df_data <- example inside the observer. additonally add this in the eventReactive(input$addrow, {...}). After pushing the button "Refresh.."I dont get the option to choose "2009" and "volatil" to display the existing value – jimbo Mar 07 '21 at 16:33

1 Answers1

1

You can add a row in eventReactive. I have added the code to add row within this code. You can source to add row. Try this

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)

output

YBS
  • 19,324
  • 2
  • 9
  • 27