jimbo
jimbo

Reputation: 13

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

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)

Upvotes: 0

Views: 1259

Answers (1)

YBS
YBS

Reputation: 21297

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

Upvotes: 1

Related Questions