【发布时间】：2021-03-09 19:36:00
【问题描述】：
我仍然是使用闪亮的初学者（下面的代码将清楚地证明这一事实）。在我正在做的工作的这个例子中，我必须生成两个条形图。这两个图都来自一组数据框，每个数据框都与不同的年份相关联。在每个数据框中都有一些行（示例中为 8 行），每一行都与一个值相关联（例如.、“值 1”、“值 2”等）。用户选择年份范围（start_year 和 end_year），服务器计算两年之间每个值的差值（例如。，2018 年的“值 1”减去“值 1” " 2015 年）。但是，在第一个条形图中只显示了有限数量的值，在本例中为 4。到目前为止，我还没有遇到任何问题。但是，我必须显示另一个条形图，链接到示例中的输入 val_select。我必须只添加第一个条形图中显示的前四个值作为此输入的选择。此外，用户可以在这个值的短列表中进行选择，并且在第二个条形图中，它将显示所选年份期间每年所选值的趋势。例如，如果在 2005-2018 年期间显示的四个值是“值 2”、“值 4”、“值 6”、“值 7”，则可以在第三个输入中选择这些值四个值，选定的一个将显示在第二个条形图中，其值介于 2005 年和 2018 年之间。
我在脚本中有两个主要问题：
- 尝试将第三个输入
val_select中的选项列表更新为updateSelectInput会导致应用崩溃； - 第二个条形图未生成并返回以下错误：
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.
下面是我在线程结束时编写的示例，尝试了所需的输出。
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)
【问题讨论】：
标签： r shiny bar-chart reactive r-highcharter