Search code examples
rshinybar-chartreactiver-highcharter

Problems with reactive dataframe and update input in shin R

I am still a beginner with the use of shiny (and the following code will clearly demonstrate this fact). I have to generate two barplot in this example of the work I am doing. Both plots are derived from a set of data frames, each one associated with a different year. In each data frame there are some rows (8 in the example), each one associated with a value (e.g., "Value 1", "Value 2", etc.). The user select the year range (start_year and end_year) and the server calculate the difference for each value between the two years (e.g., "Value 1" for year 2018 minus "Value 1" for the year 2015). However, only a limited number of values are showed in the first barplot, in this case 4. Up to this point I have not encountered any problems. However, I have to show another barplot, linked to the input val_select in the example. I have to add as choice for this input only the first four values showed in the first barplot. Moreover, the user may choose among this short-list of values and in the second barplot it will be showed the trend of the selected value for each year within the selected year period. For example, if within the period 2005-2018 the four values showed are, say, "Value 2", "Value 4", "Value 6", "Value 7", it will be possible in the third input to select among these four values and the selected one will be showed in the second barplot with its values between 2005 and 2018. I have two main problems in the script:

  1. the attempt to update the list of choices in the third input val_select with updateSelectInput crushes the app;
  2. the second barplot does not generate and returns the following error:
Problem with `mutate()` input `x`.
[31mx[39m Input `x` can't be recycled to size 2.
[34mi[39m Input `x` is `plot_data$years`.
[34mi[39m Input `x` must be size 2 or 1, not 4.

Here below the example I wrote while ad the end of the thread there is an attempt of desired output.

library(shiny)
library(shinydashboard)
library(highcharter)
library(dplyr)

# Generate data
years = c(2009:2019)

list_db = vector("list")
var = c("Value 1", "Value 2", "Value 3", "Value 4", "Value 5", "Value 6", "Value 7", "Value 8")

for (i in 1:length(years)){
    x = runif(8, min = 0, max = 100)
    df = data.frame(var, x)
    list_db[[i]] = df
}
names(list_db) = years

# UI
ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(
        sidebarMenu(
            menuItem("Page 1", tabName = 'tab_page_1'),
            selectInput(inputId = "start_year",
                        label = "Select starting year:",
                        choices = min(years):max(years)),
            selectInput(inputId = "end_year",
                        label = "Select ending year:",
                        choices = min(years):max(years)),
            selectInput(inputId = "val_select",
                        label = "Select Value (within the selected range) to show:",
                        choices = var)
        )
    ),
    dashboardBody(
        tabItem(tabName = 'tab_page_1'),
        fluidPage(
            titlePanel("Example Page 1")
        ),
        fluidPage(
            fluidRow(
                box(title = "Barplot n.1",
                    solidHeader = TRUE, 
                    status = 'primary',
                    highchartOutput("tab_1", height = 500)
                ),
                box(title = "Barplot n.2 (Value focus)",
                    solidHeader = TRUE, 
                    status = 'primary',
                    highchartOutput("tab_2", height = 500)
                ),
                
            )
        )
    )
)

# Server
server <- function(input, output, session) {
    
    # Update 'end_year' based on 'start_year' input
    
    observeEvent(input$start_year, {
        updateSelectInput(session, 'end_year',
                          choices = (as.integer(input$start_year)+1):max(years)
        )
    })
    
    # Reactive data frame
    
    react_data = reactive({
        
        # Generate starting and ending data frame
        assign("data_start", list_db[[as.character(input$start_year)]])
        assign("data_end", list_db[[as.character(input$end_year)]])
        
        # Add the selected year to variables' names
        data_start = data_start %>% rename_at(vars(-var), ~ paste0(., "_", input$start_year))
        data_end = data_end %>% rename_at(vars(-var), ~ paste0(., "_", input$end_year))
        
        # Join starting and ending data frame
        dt = full_join(data_start, data_end, by = "var")
        
        # Calculate vars' differences between the selected years
        dt$x_diff = dt[,paste0("x_",input$end_year)] - dt[,paste0("x_",input$start_year)] 
        
        # Select only first 4 Values
        dt = head(dt[order(dt$x_diff),],4)
        
    })

    # Update 'val_select' b <--- Problematic
    
    observeEvent({
        val_select_data = react_data()
        mylist = val_select_data$var
        updateSelectInput(session, 'val_select',
                          choices = mylist
        )
    })
    
    # Output 'tab_1' <--- This works
    
    output$tab_1 = renderHighchart({ 
        
        # Select data frame
        mydata1 = react_data()
        
        # Plot
        highchart() %>% 
            hc_chart(type = "bar") %>%
            hc_xAxis(categories = mydata1$var)  %>%
            hc_series(list(name = "Variables", 
                           pointWidth = 50, 
                           data = mydata1$x_diff, 
                           color = "rgba(162, 52, 52, 0.5)")) %>%
            hc_xAxis(labels = list(style = list(fontSize = "12"))) %>%
            hc_chart(plotBackgroundColor = "#EEEEEE") %>%
            hc_legend(enabled = FALSE)
    })
    
    # Output 'tab_2' <--- Problematic
    
    output$tab_2 = renderHighchart({ 
        
        # Select data frame
        mydata2 = react_data()
        
        # List of first 4 Value in the selected year range
        first_values = mydata2$var
        
        # List of years in the selected year range
        years = sort(c(min(input$start_year):max(input$end_year)))
        
        # Create a list to contain data frame for each year (inside the selected range)
        data_year = vector("list", length(years))
        
        for (i in as.character(years)){
            
            assign("df", list_db[[i]])
            
            # Consider only Value in 'first_values'
            df = df[df$var %in% first_values,]
            
            # Insert into the list
            data_year[[i]] = df
            
        }
        # Remove empty elements from the list
        data_year = data_year[!sapply(data_year,is.null)]
        
        # Generate a yearly data frame for each Value
        data_values = vector("list", length(first_values))
        years_lead = years[-1]
        
        for (row in 1:length(data_values)){
            
            df = data_year[[as.character(years[1])]][row, c(1:length(data_year[[as.character(years[1])]]))]
            
            for (i in years_lead){
                df = rbind(df, data_year[[as.character(i)]][row, c(1:length(data_year[[as.character(i)]]))])
            }
            
            df = cbind(years, df)
            data_values[[row]] = df
            
        }
        
        # Assign names to the list
        names(data_values) = paste(first_values)
        
        # Select the dataframe based on the selected profession
        assign("plot_data", data_values[[as.character(input$val_select)]])
        
        # Plot
        highchart() %>% 
            hc_title(text = input$val_select) %>%
            hc_subtitle(text = "Trend in the considerd period") %>%
            hc_chart(type = "column") %>%
            hc_add_series(name = "Amount",
                          data = plot_data,
                          type = "column",
                          hcaes(x = plot_data$years, y =  plot_data$x),
                          color = "rgba(0, 102, 102, 0.6)",
                          yAxis = 0) %>%
            hc_xAxis(labels = list(style = list(fontSize = "12")),
                     opposite = FALSE) %>%
            hc_chart(plotBackgroundColor = "#EEEEEE") %>%
            hc_legend(enabled = FALSE)
    })
    
}

# UI
shinyApp(ui = ui, server = server)

enter image description here Thank you in advance to anyone who can give me some suggestions and I apologize in advance for my probably 'clumsy' code.

Solution

  • The second observeEvent was not working as you did not account for null values. Also, initially the start and end years are same, and that should be accounted in the reactive data. Once you fix this part, the graph on the left is fine and the data for the second graph is also fine. However, I am not sure if that is the data you want to plot on the right. Once you are sure, you need to adjust the syntax of the second highchart in output$tab_2. Try this code:

    library(DT)

# Generate data
years = c(2009:2019)

list_db = vector("list")
var = c("Value 1", "Value 2", "Value 3", "Value 4", "Value 5", "Value 6", "Value 7", "Value 8")

for (i in 1:length(years)){
  x = runif(8, min = 0, max = 100)
  df = data.frame(var, x)
  list_db[[i]] = df
}
names(list_db) = years

# UI
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Page 1", tabName = 'tab_page_1'),
      selectInput(inputId = "start_year",
                  label = "Select starting year:",
                  choices = min(years):max(years)),
      selectInput(inputId = "end_year",
                  label = "Select ending year:",
                  choices = min(years):max(years)),
      selectInput(inputId = "val_select",
                  label = "Select Value (within the selected range) to show:",
                  choices = var)
    )
  ),
  dashboardBody(
    tabItem(tabName = 'tab_page_1'),
    fluidPage(
      titlePanel("Example Page 1")
    ),
    fluidPage(
      useShinyjs(),
      fluidRow(
        box(title = "Barplot n.1",
            solidHeader = TRUE, 
            status = 'primary', 
            highchartOutput("tab_1", height = 500)
        ),
        box(title = "Barplot n.2 (Value focus)",
            solidHeader = TRUE, 
            status = 'primary',  DTOutput("tb2")
            #highchartOutput("tab_2", height = 500)
        ),
        
      )
    )
  )
)

# Server
server <- function(input, output, session) {
  plotme <- reactiveValues(data=NULL)
  # Update 'end_year' based on 'start_year' input
  
  observeEvent(input$start_year, {
    updateSelectInput(session, 'end_year',
                      choices = (as.integer(input$start_year)+1):max(years)
    )
  })
  
  # Reactive data frame
  
  react_data <- reactive({
    req(input$start_year,input$end_year)
    
    if (input$start_year == input$end_year){
      dt <- NULL
    }else {
      # Generate starting and ending data frame
      assign("data_start", list_db[[as.character(input$start_year)]])
      assign("data_end", list_db[[as.character(input$end_year)]])
      
      # Add the selected year to variables' names
      data_start = data_start %>% rename_at(vars(-var), ~ paste0(., "_", input$start_year))
      data_end = data_end %>% rename_at(vars(-var), ~ paste0(., "_", input$end_year))
      
      # Join starting and ending data frame
      dt = full_join(data_start, data_end, by = "var")
      
      # Calculate vars' differences between the selected years
      dt$x_diff = dt[,paste0("x_",input$end_year)] - dt[,paste0("x_",input$start_year)] 
      
      # Select only first 4 Values
      dt = head(dt[order(dt$x_diff),],4)
    }
    dt
    
  })
  
  output$tb1 <- renderDT(react_data())
  
  # Update 'val_select' b <--- Problem fixed when you account for react_data() not being NULL
  
  observeEvent(list(input$start_year,input$end_year), {
    if (!is.null(react_data())) {
      mylist <- as.character(react_data()[,1])
      updateSelectInput(session, 'val_select', choices = mylist )
    }
  })
  
  # Output 'tab_1' <--- This works
  
  output$tab_1 = renderHighchart({ 
    if (is.null(react_data())) return(NULL)
    # Select data frame
    mydata1 = react_data()
    
    # Plot
    highchart() %>% 
      hc_chart(type = "bar") %>%
      hc_xAxis(categories = mydata1$var)  %>%
      hc_series(list(name = "Variables", 
                     pointWidth = 50, 
                     data = mydata1$x_diff, 
                     color = "rgba(162, 52, 52, 0.5)")) %>%
      hc_xAxis(labels = list(style = list(fontSize = "12"))) %>%
      hc_chart(plotBackgroundColor = "#EEEEEE") %>%
      hc_legend(enabled = FALSE)
  })
  
  observe({
    req(input$start_year,input$end_year,input$val_select)
    if (is.null(react_data())) return(NULL)
    # Select data frame
    mydata2 = react_data()
    
    # List of first 4 Value in the selected year range
    first_values = mydata2$var
    
    # List of years in the selected year range
    years = sort(c(min(as.numeric(input$start_year)):max(as.numeric(input$end_year))))
    
    # Create a list to contain data frame for each year (inside the selected range)
    data_year = vector("list", length(years))
    
    for (i in as.character(years)){
      
      assign("df", list_db[[i]])
      
      # Consider only Value in 'first_values'
      df = df[df$var %in% first_values,]
      
      # Insert into the list
      data_year[[i]] = df
      
    }
    # Remove empty elements from the list
    data_year = data_year[!sapply(data_year,is.null)]
    
    # Generate a yearly data frame for each Value
    data_values = vector("list", length(first_values))
    years_lead = years[-1]
    
    for (row in 1:length(data_values)){
      
      df = data_year[[as.character(years[1])]][row, c(1:length(data_year[[as.character(years[1])]]))]
      
      for (i in years_lead){
        df = rbind(df, data_year[[as.character(i)]][row, c(1:length(data_year[[as.character(i)]]))])
      }
      
      df = cbind(years, df)
      data_values[[row]] = df
      
    }
    
    # Assign names to the list
    names(data_values) = paste(first_values)
    
    # Select the dataframe based on the selected profession
    assign("plot_data", data_values[[as.character(input$val_select)]])
    plotme$data <- plot_data
    
    output$tb2 <- renderDT(plotme$data)
    
    # Output 'tab_2' <--- Problematic  - needs some work to fix the highchart
    
    output$tab_2 = renderHighchart({
      plot_data <- plotme$data
      if (is.null(plot_data)) return(NULL)
      # Plot
      plot_data %>% 
      highchart() %>% 
        hc_title(text = unique(plot_data$var)) %>%
        hc_subtitle(text = "Trend in the considerd period") %>%
        hc_chart(type = "column") %>%
        hc_add_series(name = "Amount",
                      #data = plot_data,
                      type = "column",
                      hcaes(x = plot_data$years, y =  plot_data$x),
                      color = "rgba(0, 102, 102, 0.6)",
                      yAxis = 0) %>%
        hc_xAxis(labels = list(style = list(fontSize = "12")),
                 opposite = FALSE) %>%
        hc_chart(plotBackgroundColor = "#EEEEEE") %>%
        hc_legend(enabled = FALSE)
    })
  })
  
}

# UI
shinyApp(ui = ui, server = server)

    output