Problems with reactive dataframe and update input in shin R - r

Question

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:
the attempt to update the list of choices in the third input val_select with updateSelectInput crushes the app;
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)
Thank you in advance to anyone who can give me some suggestions and I apologize in advance for my probably 'clumsy' code.

Answer 1

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)

Answer 2

Thank you so much #YBS for your kind answer. With some adjustments it worked.
I had to sort both mylist and first_values to have the correspondence between the selected choice in the input 'Select Value (within the selected range) to show:' and the displayed table/barplot. Moreover, the problem with the second barplot was associated with the name I gave to the vertical axis... 'x', shame on me for such choice. In fact, I tired with ggplot2 and it worked. Then, by renaming the variable the script works just fine. Thank you again. Below the edited script I modified following your suggestions.
library(shiny)
library(shinydashboard)
library(highcharter)
library(dplyr)
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(
fluidRow(
box(title = "Barplot n.1",
solidHeader = TRUE,
status = 'primary',
highchartOutput("tab_1", height = 500)
),
box(title = "Table n.1 (Value focus)",
solidHeader = TRUE,
status = 'primary',
DTOutput("tab_2")
),
box(title = "Barplot n.2 (Value focus)",
solidHeader = TRUE,
status = 'primary',
highchartOutput("tab_3", 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
})
# Update 'val_select'
observeEvent(list(input$start_year,input$end_year), {
if (!is.null(react_data())) {
mylist = as.character(react_data()[,1])
updateSelectInput(session, 'val_select', choices = sort(mylist))
}
})
# Output 'tab_1'
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' and 'tab_3'
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
first_values = sort(first_values)
# 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 value
assign("plot_data", data_values[[as.character(input$val_select)]])
plotme$data = plot_data
# Plot table 'tab_2'
output$tab_2 = renderDT(plotme$data)
# Plot table 'tab_3'
output$tab_3 = renderHighchart({
#plot_data = plotme$data
if (is.null(plot_data)) return(NULL)
names(plot_data)[names(plot_data) == 'x'] = 'variable'
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 = years, y = variable),
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)