shin R 中反应性数据帧和更新输入的问题
Problems with reactive dataframe and update input in shin R
我仍然是 shiny 的初学者（下面的代码将清楚地证明这一事实）。我必须在我正在做的这个工作示例中生成两个条形图。这两个图都来自一组数据框，每个数据框都与不同的年份相关联。在每个数据框中都有一些行（示例中为 8 行），每一行都与一个值相关联（例如.、“值 1”、“值 2”等）。用户 select 年份范围（start_year 和 end_year）和服务器计算两年之间每个值的差异（e.g., 2018 年的“值 1”减去 2015 年的“值 1”）。但是，第一个条形图中只显示了有限数量的值，在本例中为 4。到目前为止，我还没有遇到任何问题。但是，我必须显示另一个条形图，链接到示例中的输入 val_select。我必须仅添加第一个条形图中显示的前四个值作为此输入的选择。此外，用户可以在 short-list 个值中进行选择，在第二个条形图中，将显示 selected 年期间每年 selected 值的趋势。例如，如果在 2005-2018 期间显示的四个值是“值 2”、“值 4”、“值 6”、“值 7”，则可能在 [=37 的第三个输入中=] 在这四个值中， selected 将显示在第二个条形图中，其值介于 2005 年和 2018 年之间。
我在脚本中有两个主要问题：
- 尝试用
updateSelectInput 更新第三个输入 val_select 中的选项列表会破坏应用程序；
- 第二个条形图不生成并且returns出现以下错误：
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)
提前感谢任何能给我一些建议的人，我提前为我可能 'clumsy' 的代码道歉。
第二个 observeEvent 没有工作，因为您没有考虑空值。此外，最初开始和结束年份相同，这应该计入反应数据。修复此部分后，左边的图就可以了，第二张图的数据也可以了。但是，我不确定这是否是您要在右侧绘制的数据。确定后，您需要调整 output$tab_2 中第二个高图的语法。试试这个代码：
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)
非常感谢@YBS 的热心回答。通过一些调整，它起作用了。
我必须对 mylist 和 first_values 进行排序，以便在输入 'Select Value (within the selected range) to show:' 中选择的选项与显示的 table/barplot 之间存在对应关系。此外，第二个条形图的问题与我给垂直轴的名称有关... 'x'，我为这样的选择感到羞耻。事实上，我厌倦了 ggplot2 并且它起作用了。然后，通过重命名变量，脚本就可以正常工作。再次感谢你。在我根据您的建议修改的编辑脚本下方。
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)
我仍然是 shiny 的初学者（下面的代码将清楚地证明这一事实）。我必须在我正在做的这个工作示例中生成两个条形图。这两个图都来自一组数据框，每个数据框都与不同的年份相关联。在每个数据框中都有一些行（示例中为 8 行），每一行都与一个值相关联（例如.、“值 1”、“值 2”等）。用户 select 年份范围（start_year 和 end_year）和服务器计算两年之间每个值的差异（e.g., 2018 年的“值 1”减去 2015 年的“值 1”）。但是，第一个条形图中只显示了有限数量的值，在本例中为 4。到目前为止，我还没有遇到任何问题。但是，我必须显示另一个条形图，链接到示例中的输入 val_select。我必须仅添加第一个条形图中显示的前四个值作为此输入的选择。此外，用户可以在 short-list 个值中进行选择，在第二个条形图中，将显示 selected 年期间每年 selected 值的趋势。例如，如果在 2005-2018 期间显示的四个值是“值 2”、“值 4”、“值 6”、“值 7”，则可能在 [=37 的第三个输入中=] 在这四个值中， selected 将显示在第二个条形图中，其值介于 2005 年和 2018 年之间。
我在脚本中有两个主要问题：
- 尝试用
updateSelectInput更新第三个输入val_select中的选项列表会破坏应用程序； - 第二个条形图不生成并且returns出现以下错误：
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)
第二个 observeEvent 没有工作，因为您没有考虑空值。此外，最初开始和结束年份相同，这应该计入反应数据。修复此部分后，左边的图就可以了，第二张图的数据也可以了。但是，我不确定这是否是您要在右侧绘制的数据。确定后，您需要调整 output$tab_2 中第二个高图的语法。试试这个代码：
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)
非常感谢@YBS 的热心回答。通过一些调整，它起作用了。
我必须对 mylist 和 first_values 进行排序，以便在输入 'Select Value (within the selected range) to show:' 中选择的选项与显示的 table/barplot 之间存在对应关系。此外，第二个条形图的问题与我给垂直轴的名称有关... 'x'，我为这样的选择感到羞耻。事实上，我厌倦了 ggplot2 并且它起作用了。然后，通过重命名变量，脚本就可以正常工作。再次感谢你。在我根据您的建议修改的编辑脚本下方。
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)